Drupal blog posts

空间之觉：一种建筑现象学

highflybird — Thu, 18 Feb 2021 03:41:37 +0000

空间之觉：一种建筑现象学 highflybird 周四, 02/18/2021 - 11:41

此文来自:https://ptext.nju.edu.cn/c1/92/c12242a246162/page.htm

空间之觉：一种建筑现象学

严惟愉

“诗人和画家来自于现象学家。”[2]
艺术家使用现象学的方法意味着对事物本质的纯粹的看，放下了经验和理性的解释。一个作家、画家、导演设置一个场景，必须限定一个行为发生的背景和环境，假想一个地点，而“创造空间”是建筑师的首要任务，因此，这些艺术家不自觉地承担了建筑师的任务。由于没有受到建筑学专业的规则和教条的基础，艺术家更能达到建筑体验的精神度向，也更为直接的显示出建筑艺术的现象学基础。塔可夫斯基[3]（Tarkovsky）的电影《乡愁》（Nostalgia）中富有诗意的空间和光的图像，便是这样一部建筑现象学的长诗。它触及建筑学存在的基础，充满了被渐渐忘却的童年时的记忆和经验，通过空间的图像，揭示了物质与现象、有形与无形、庇护与暴露、过去与现在、有限与无限的交融流转。

记忆：塔可夫斯基电影《乡愁》中的影像与空间
塔可夫斯基的影片有一种俄罗斯乡间田园的影像和诗歌风格：《乡愁》序幕的开篇镜头便是绘画般的风景：树、水、狗、模糊的黑白风景，以及风景中缓慢行走的人的黑色剪影；（图1）紧接着影片开始，出现的是迷雾中青葱的意大利乡村风景，一辆大众汽车从画面右侧横穿画面至左，短暂的消失之后又从画面左下侧驶出，安德烈·戈查可夫（Andrei）和尤金尼亚（Eugenia）走出车外。接着是乡村小教堂中逆光的密密阵列的柱子，镜头从二点斜透视缓慢变为一点透视停止下来；山坡上的小木屋安静地伫立在画面上方，如同从山腰上生长出来一般；雾气缭绕的露天浴池，镜头与主人翁的背影、池中的雾气同时向画面左方缓慢移动；戈尔恰科夫和尤金尼亚在旅馆走廊中的谈话，首先听到声音，然后分别看到两位主人公。影片中多处出现古典拉丁式建筑的褐色石块，缀满碧绿针叶的意大利松树，蒸汽氤氲的维尼奥尼温泉浴池的景像。还有多米尼戈（Domenico）水淹的房间，残破的墙面，星星点点的光线，半堵坍塌墙壁上可以打开的门，半透明的绿色和棕色酒瓶，淅沥的雨滴，废墟里水晶般的积雨，跳跃的光影，摆动的水草，潮湿的绿色植被，弥漫的忧郁……

塔可夫斯基的影像让人想起绘画，特别是文艺复兴早期的俄罗斯绘画。塔可夫斯基年轻时曾经画过三年画，他的第二部影片《安德烈·鲁勃廖夫》[4]（Andrei Rublev）便是关于15世纪俄罗斯肖像画家鲁勃廖夫[5](Rublev)，在他的著作中时常会提到达利、凡高、哥雅、拉菲尔等众多的画家。但他本人却强调电影和绘画这两种艺术形式的不同，认为“随着时间的发展，我认为，电影将远离文学和其他艺术形式，成为越来越自主的艺术。” 电影空间与绘画空间有所不同，正如安德列·巴赞[6]（Andre Bazin）在《电影是什么》中阐述的：“画框与周围空间毗连，形成一个与自然空间相对立的，与真实空间相对立的内向空间，这个关照性空间仅仅向画内开放……银幕的边缘不是画框，银幕展现的景色似乎可以延伸到外部世界，画框是内向的，银幕是离心的。”[7]正是电影空间的这种特质，使塔可夫斯基得以在银幕内展示无限深远的空间，并且溶入观者，指向观者的内心世界。

塔可夫斯基的影像空间大多以一点透视的方式展现，如同戏剧一样，这种传统的空间表达有助于压平银幕图像。《乡愁》通过雾、水、雨、黑夜模糊了影像、空间和形体的边缘，使影像从现实中抽离出来，弱化真实效果，强调出平面感。这样，黑夜、弥散的雾，甚至透空的栏杆都参与到场面调度中来，成为塔可夫斯基电影中空间塑形的参与者。这近乎于中国山水画中的空间场景，也和日本枯山水中使用裸砂的方法如出一辙。正因如此，塔可夫斯基的影像具有一种平面感，它弱化真实空间深度的同时，扩展了心理空间的深度，消除了现象与本质对立的深度模式，空间从背景中走出，变成正文。（图2）

门和窗在塔可夫斯基电影中扮演着不可替代的角色，门和窗让光线进来，让视线穿过，人和观众从这里看进来或者看出去，从而创造了一系列令人惊讶的形而上学的美丽（图3）。其中一个经典镜头是：左边一方是狭长的窗，明亮的，下着雨；右边下方是同样狭长的门，里面有块大圆镜子，忽明忽暗地辉映着雨；中间有一张大床，寂寞的俄罗斯诗人横卧着；床上方的栏杆，有优美的线条，却在光影里显得很落寞。这个构图是完美的，从细部来说，有些活泼的对比，比如方和圆，亮和暗，上和下，纤巧和厚重，并且错落有致地安排了三个空间。（图4）

废墟，在影片里隐含了一种记忆，但并非简单的象征和隐喻。废墟的特别之处在于抓住了我们的情感，因为它让我们想起那些被遗忘的信仰。比起新的建筑物，人更容易被它打动，废墟剥去了实用和理性的面纱，它不完全是一个建筑物，已经停止扮演建筑物的角色，它显示出记忆的结构骨骼，是一种纯粹忧郁的情绪。房屋与废墟的区别形成了一种潜在的记忆，换言之，房屋、记忆在废墟里得到了统一。虽然在真实的建筑学中很少面对漏雨或被水淹没的房间，但在塔可夫斯基的电影里，这种影像十分有力，这种冲击力来自于房子和水，来自于庇护和暴露、有形和无形、有限和无限的特有意象的溶解（图5）。当代社会似乎有一种取消历史感和擦除时间痕迹的倾向，人们更热衷于以后现代式的无意识的拼贴（Collage）取代现代时期的有意识的剪辑（Montage），时间和空间的特殊形式产生了断断续续的碎片，使人们的记忆显得无所适从。而塔可夫斯基却似乎向我们证明，历史感不仅仅是个体对人类时间存在的意识，或对过去历史规律的意识，而可以是一种新的模糊的和似曾相识的记忆。
时间是塔可夫斯基电影里与空间紧密相关的另一个重要维度。塔可夫斯基的作品中的影像诗学，正源自于他对时间的描摩。在他的作品中，总是能让观者清楚地意识到时间的存在，一秒钟的流逝——在枯叶飘落，在水面涟漪的波纹和荡漾的水草，在一声轻杳的喟然叹息中。如果说时间是有重量的，那么藉影像所雕刻的时间重量，可以说是一个巨大存在。对塔可夫斯基而言，电影的本质就是“时间”。透过事实的具体形象，电影中的时间仿佛是真实时间的铸形，在人物移动和环境形态中，影像、时间以及与时间牢不可分的物质世界共同构成了电影艺术（图6）。他说道：“在电影里，我们纪录某一空间，是为了创造出时间的幻觉。”[8]在塔可夫斯基的《雕刻时光》一书中，他表示：“我至今仍无法忘怀出现于上个世纪的那部天才之作、揭开电影序幕的影片《火车进站》[9]（L'Arrivee d'un Train en Gare de La Ciotat）……那正是电影诞生的时刻，它不只是技术问题，也不只是一种再现世界的新方法，而是一种全新的美学原则的诞生。因为人类首度发现了留取时间印象的方法。”[10]

电影是时间的艺术，并且是惟一可以用时间长度来计量的艺术。当爱森斯坦用“特写镜头”把某个人物突现出来的时候，他仿佛是在进行剪辑，并在时间上重新加以安排，从而揭示出壁画的戏剧性实质。爱森斯坦事实上是从“单纯的空间艺术”中挖掘出潜在的时间维度[11]。而塔可夫斯基更多地像巴赞主张的那样，使用长镜头来表达时间的绵延。当我们看到《乡愁》里流落异乡的戈查可夫，手捧着闪烁的微弱烛火，小心翼翼的横越荒芜的温泉水池，从银幕这端到那端，随着烛火的移动，影像建构了另一个流动的时空（图7）。闪烁烛火的“动”和缓慢到几乎让人察觉不出移动的镜头摇摄的“静”在这一个长镜头内，构筑了属于戈查可夫、属于影像本体的时间宇宙，涵涉其内的是交融了主人翁记忆与追寻情感的厚度，投射于外的则是某种经验在时间的长度中延伸、强化、凝聚。这样的时空犹如存在于每个人心底的幽冥之境，过去与现在、记忆与渴望在此刻交织成一片时空的混沌，简单的影像下触及的是内心世界深层活动状态。塔可夫斯基说道：“时间或空间两者都不存在于与人类范畴相关的事物之外。”时间成了每个人的自我宇宙的计量器，每一段生命轨迹中细微的情感质量变化，都形成不同的时间宇宙。记忆、欲望、追寻，电影承载了某种时间的流逝、消耗和延展，也召唤观者以自我生命经验的共鸣（图8）。

塔可夫斯基在《雕刻时光》中曾明确表示他的电影中没有象征和隐喻，水就是简单的水，雨就表达雨的经验。直觉，在塔可夫斯基的影片中显得尤其重要。《乡愁》的风景充满了作者的心灵感受，用一个患有强烈思乡症者的目光反映出来。对大自然及其不断变化的形态与气候的深切感受，从宽广的地平线到对一片树叶上的细微纹理的审视，都是艺术家在生活中寻找到的无限的美和魅力所在。塔可夫斯基似乎正沿着胡塞尔[12]所说的“回到事物本身”（zur焎k zu den Sachen selbst）的路在行走，而且，与柏格森[13]的直觉主义和法国新浪潮电影的“电影是每秒二十四格的真实”[14]不同的是，塔可夫斯基强调的却是一种现象学的意象，一种藉本质直观（Wesenschau）把经验还原为现象，强调意象活动和意向性（Intentionalit妕）体验，包含主体意识的意象性真实的现象学真实。

绵延：一种空间知觉

德勒兹[15]曾指责现象学没有理解电影，将电影与自然感觉相对立，从而贬低了电影的重要性。[16]他把画面分为两种：一种是有机流动的状态，为画面—运动的状态；另一种是晶体状态，为画面—时间状态。德勒兹认为塔可夫斯基的电影属于画面—晶体一种，趋向于对纯时间的表现。

纯时间指的就是柏格森所说的绵延（Duration），是一种强调主观意识的时空观念。柏格森在《时间与自由意志》里批评了康德的时空观，他认为康德在现象与本体之间划了一道无法越过的鸿沟，“康德设想一方面有物自体（Sachen an sich），一方面有纯粹的时间和纯粹的空间，物自体通过这种时间和空间被折射出来……时间和空间不在我们之外，也不在我们之内；内外的区别自身是时间与空间的作用……他把现象界连根带叶交给我们的悟性，而对本体界则不许我们问津。”[17]柏格森似乎在设法跨越康德设置的鸿沟，他认为“这道鸿沟也许不是他（康德）所设想的那样难以越过。”[18]柏格森试图通过“绵延”来统摄以上对象，试图使内在意识与物理时空统一起来。

在康德的观念里，空间并非实在之物，空间是“外感所有一切现象之方式”[19]，时间则是“内感之方式”，亦非实在之物。而时间与空间，“合而言之，为一切感性直观之纯粹方式，而使先天的综合命题之所以可能者。”[20]柏格森却坚信“空间是实在的东西”，并且说道：“康德远未动摇我们这个信仰。”[21]柏格森首先承认物质世界，认为物理学时间是可测量的，因此是纯一的。同样，空间是纯一的，因为空间是可度量的。他认为，绵延不等同于时间，“时间是纯一的，它的各个瞬间被串在一根线上，而绵延是多样性的，它的各个瞬间相互渗透。”他把时间理解为一种被人工重造出来的自我，以及种种简单的心理状态，这些状态可以彼此凑合再分开，而把绵延理解为一种内心状态，其先后各个阶段是独特无二的。柏格森认为时间有两种概念，他指出：“对时间确有两种可能的概念，一种是纯粹的，没有杂物在内，一种偷偷地引入了空间的观念。”这就是他所说的抽象的时间和具体的绵延，“真正绵延的各个瞬间是相互渗透的而不是并排置列的。”[22]

柏格森认为时间和空间两者是不能相互还原的，他提出这样一个命题：如果能证明两者之一能还原为其中另一者，才能否定事物具有时间与空间这两种形式。“无论怎样，我们若不事先问明二者之一是否不能还原为其中之另一，则我们终不能承认纯一的东西具有两种形式，即时间与空间。”他否定了“那些企图把二者之一还原为另一的哲学家，由于他们为时间观念之明显的简单性所迷误，就认为他们能把绵延变为广度。”[23]

可以如此理解：柏格森的绵延是时间、空间，加上其在身内意识组织渗透的过程。柏格森实际上假定了空间与时间的界限，把“空间”与“时间”定义在狭义的物理学范围内，他所说的空间指的是物理学空间，时间指的也正是物理学时间，这样的定义为他的“绵延”理论留出了位置。因此，我们可以认为柏格森的“空间”和康德的“空间”并非一个词语，因此，他的空间实在论和康德的空间非实在论也并非完全矛盾。尽管柏格森的思想不像康德一丝不苟，但这个被梅洛-庞蒂[24]称为“一个搞乱了哲学与文学的人”[25]还是为我们开启了另一扇重要的门——知觉的门。

人的感觉和知觉是人向世界开放的第一个器官，也是世界向人进入的第一道关口。梅洛-庞蒂在《知觉现象学》里，分析了知觉世界的结构以后，阐述了我们感觉到的外部世界的性质、空间位置、深度和运动的具体经验，展开了我们所有的知觉经验的外部世界。
在梅洛—庞蒂看来，城市空间不仅仅是一个物体（客观实在），“巴黎的城市空间不是一个有千万种面貌的物体，不是知觉的总和，也不是所有知觉的规律。我在游览巴黎时得到的每一个鲜明的知觉——咖啡馆，人的脸，码头边的杨树，塞纳河的湾道，就如一个人在他的手势、步态和嗓音中表现出的同一种情绪——同样清楚地出现在巴黎的整个存在中，都表明巴黎的某种风格或某种意义。当我第一次到巴黎时，走出车站最初看到的大街，如同我最初听到的一个陌生人的话语，只不过是一种很模糊但已是独一无二的本质表现。”[26]空间存在于意识之中，而且任何空间都有联系着它的各部分思维支撑着。假如人在黑夜里失去器官知觉，便失去了空间深度。“黑夜不是在我面前的一个物体，它围绕着我，它通过我的器官进入我，它窒息我的回忆，它几乎抹去我的个人认知。我不再以我的知觉器官作为掩护，以便从那里看物体的轮廓在远处展现。黑夜没有轮廓，它接触我，它的统一性就是超自然的神秘统一性。但只要黑夜远处隐隐约约充满喊叫声和光线，它就能整个地活跃起来，它是一种没有平面、没有表面、没有它和我之间距离的一种深度。”[27]黑暗屏蔽了知觉，也因此屏蔽了空间，如同电影院中的黑暗，压平了真实空间的深度，而打开了电影空间与画面的深度。
梅洛-庞蒂以绘画中的“透视”来说明一个重要的道理，即艺术家在一个二维的平面上，做出了一个虚假的三维深度。他认为人们看见了深度，而深度并不是真实可见的，因为深度是从我们身体开始，到物体的距离来计算的。这个奥秘是一个虚假的奥秘，人们并非真实的看见了深度，即使看见了，也是另一种深度，是人的视觉本身遮蔽了一些东西，而又向人们敞开了一些东西。

梅洛-庞蒂强调主体的重要，认为主体是一种既在知觉中，又被知觉到的主体，即知觉的中心。他批评了萨特和海德格尔的存在主义，超越了伯格森的空间实在论，对康德和胡塞尔著作中的某些康德主义的概念也进行了扬弃。《知觉现象学》认为哲学的第一个行动，应该是深入到先在的客观世界中去重新发现现象，重新唤醒知觉，并私下使其自身成为一种事实和一种知觉。

空间、物质和时间，在建筑里会纠缠集结，穿越意识，融入一个单一的向度，融入存在的基本的物质性里。人们在这样的空间中能辨别出自己，此时，这种空间的尺度变成了我们存在的一个部分。建筑学是人类和外部世界之间的调和的一种艺术，知觉正是这种调和发生的媒介。建筑学是所有艺术形式中最能全面反映人类知觉的空间艺术，建筑学中引入现象学方法可以开辟出一种视野，确立一种观念和态度。正是在这个意义上，建筑现象学使建筑艺术走出单纯的社会—建筑师—使用者的研究方式，使建筑学成为一种主体间性（Intersubjektivit妕）的对话交流方式。

身体：一种建筑现象学

作为艺术实践的建筑学与社会实践的建筑学有所不同，它们可以被认为是两种不同的建筑学。当代西方建筑学由于物质功能需求的减少而更多地倾向于艺术领域，因此，作为当代艺术理论重要基础的现象学在建筑学中终究有了合理地位，并且越来越多地为建筑师所接受。建筑师们认为与其他艺术形式相比，建筑更能全面的反映人类的知觉，体现现象学的意义。
帕拉斯玛（Juhani Palasmma）[28]在他的文章《建筑七感》（An Architecture of the Seven Senses）中，列举了人对建筑的七种知觉，完整的阐述了作为现象学的知觉在建筑学中的作用。帕拉斯玛认为，不同的建筑可以有不同的感觉特征，除了通常流行的“眼睛的建筑学”或者说“视觉建筑学”，还应该有一种肌肤的、触觉的建筑学，一种重新认识听觉、嗅觉和味觉的建筑学。柯布西耶的建筑明显倾向于视觉，相反的，始于门德尔松（Erich Mendelson）和汉斯·夏隆（Hans Scharoun）的表现主义建筑，则倾向于塑性和触觉，倾向于反对视觉主义的透视中心论。帕拉斯玛采用现象学的方法分析了建筑中人的各种感受，强调身体，即知觉主体经验的重要。帕拉斯玛研究建筑中的现象学问题，其现象学理论依据主要源自于法国哲学家梅洛-庞蒂和加斯东·巴士拉（Gaston Bachelard）。巴士拉晚年通过自己女儿（胡塞尔的门徒）了解到现象学，但他的现象学与现象学运动中严格意义的现象学哲学有所不同，尤其在意识中的直接被给与的内在直观方面，即直观所与方面很难和胡塞尔接近，在操作性概念结构的方法方面也与现象学有相互矛盾。巴士拉自己不希望把自己与胡塞尔的纯粹现象学联系起来，他反对“哲学沉思”，主张“现象技术”，他的哲学是一种“行动的哲学”，甚至是一种“唯物主义的现象学”[29]。可以认为，帕拉斯玛从巴士拉那里获得了比较直接的动力，在把现象学应用于建筑学领域方面做出了大胆的尝试。

他说道：“眼睛是一种强调距离和间隔的器官，而触摸则强调亲近、私密和友爱的感受。我们这个年代，光变成纯粹定量的物质，窗户失去它作为开启和关闭、室内和室外、私密和公共、阴影和光明等等两个世界之间的介质的特征，窗户变成了纯粹是墙面上的一个缺口。因而失去了它本体论的意味。用路易斯·巴拉干（Luis Barragan）的观点来说，对大多数的当代住宅而言，把墙面上窗户的数量减少一半，也许会更令人愉快。同样，对大多数公共空间而言，把光线强度减小一半，也许更令人高兴。”[30]

“手是一个复杂的器官，是一个三角地，来自四面八方的生命信息源源不断的在这里汇聚，汇聚成行为的河流。人的双手有它们自己的历史，有它们自己的文明。它们也因此显得特别美丽。雕塑家的手是认识世界和独立思考的器官，因此，手是雕塑家的眼睛。手可以阅读，阅读物体的肌理、重量、密度和温度。当我们握住门的把手就是和建筑握手。触觉感知把我们和时间及传统联系在一起。”[31]这正如康德所说：手是人外在的大脑。

建筑学中，人的行动蕴藏着一个潜在的暗示，就像草地上的垫脚石是人脚的印痕和图像。当我们打开一扇门，身体的重量便遇到了门的重量，踩上台阶时腿便度量着踏步，人的手和门的把手相遇，整个身体倾斜着、戏剧性的穿过空间。“我们身体周围的物体反映出可能的行为”——柏格森在《物质与记忆》里这样说道。值得回味的建筑体验往往不仅仅是简单的视网膜的图像，建筑学的元素不仅是视觉单位和完形。当走进路易·康的萨尔克（salk）生物楼前巨大的室外空间时，一种不可抗拒的诱惑引领我们直接走向它那素混凝土墙面，去触摸那像丝绒般平滑温暖的表面。皮肤能准确的追踪有温度变化的空间，如树阴下凉爽的、生机勃勃的影子，阳光照射下温暖的光斑。

阿尔瓦·阿尔托在他的建筑里，有意识的关注到所有的知觉，“家具的一个片断形成一个人日常生活的一部分，它不应当过于光滑耀眼，它也不应当不利于声音和声音的吸收，等等。与人接触的最为亲密的一个片断，如一只椅子，就不应当用那些导热性能太好的材料来制造。”[32]与纯粹的视觉美学相比，阿尔托更感兴趣于物品与使用者的身体相遇。

阿尔托的建筑展现出肌肤与触觉的在场。他的建筑综合了错位、斜面、不规则形和多重节奏，以此来唤醒身体、肌肉和触觉的经验。他依*手工精心制作的表面纹理和细部，唤起了人们的触觉，创造了温暖亲切的氛围。阿尔托的建筑不是基于笛卡尔式的理想主义的视觉建筑学，而是基于感觉的真实；同样，也不是基于统一和完形，而是感觉的聚合物（图8-11）。阿尔托的建筑常常显得笨拙和未完成的样子，但它们却可以被理解为：真实的物质与空间在“肉身”（Flesh）中相遇——不是作为理想化的视觉构筑物。

相反的是，在当代建筑中，我们很少看到像阿尔托这样专注于人类知觉的建筑师。今天的建筑师，更多地热衷于视觉图像的冲击和新技术的表现。生活世界的物质实体被虚拟现实所代替，虽然真实的“物质性”愈来愈陌生，但虚拟的“世界”却正在成为“另一种物化”。雷姆·库哈斯更多地显示出他社会学家的天才，他的技巧更多显示在社会学而不是建筑学领域；赫尔佐格是一个技术高明的试验家，他关注建筑自身，表现出对建筑与材料丰富实体感的偏爱，但这种物质主义并未能唤起人们的回忆，更多地是充满着如同博依斯[33]（J. Beuys, 1921-1986）艺术中表现出的新奇躁动和陌生不安。因为缺失记忆，赫尔佐格便像个技术领航员，他未能进入我们的精神领域，他的建筑亦不属于现象学领域。而另外一类建筑师，如斯维尔·费恩、索托·莫拉、格兰·默科特、阿尔瓦罗·西扎、安藤忠雄等，也包括年迈的伍重，却能让我们不断地在其建筑中找到某些回忆和知觉的共鸣（图12）。

结语：唤起失忆的空间

今天的建筑患了失忆症，正在失去知觉，失去记忆，它们很少能够进入诗的领域，或能够唤醒世界潜意识的意像。当代建筑热衷于视觉冲击，缺少直觉和恍惚的话语，缺少一些悲情、伤感和回忆的情绪。建筑学应该再次追问它在物质性和实用性上的功能和存在，使之能触及人类深层意识，触及梦和情感——如同塔可夫斯基、帕拉斯玛和梅洛-庞蒂揭示的那样，使之成为艺术实践中不可或缺的风景。人类器官正在失去知觉的今天，“影像感知”越来越多地代替“真实感知”，“影像空间”更多地取代“真实空间”。艺术愈来愈多地依赖于复制，复制本身已变为一种艺术，正如同本雅明[34]（Walter Benjamin）所说的，机器复制使艺术从仪式中解放出来成为另一种实践[35]。而复制的先天不足在于主体的缺席，亦如詹姆逊(Fredric Jameson)所认为：复制的核心是主体的丧失，即“主体之死”[36]。塔可夫斯基用他电影画面的本体论和现象学经验做出了回答，让我们察觉到艺术可以如此唤醒主体，唤起知觉和记忆，艺术作品更是人、观者与作品的对话。

“回到事物本身”（zur焎k zu den Sachen selbst）是现象学家的第一个行动，也可以成为艺术家和建筑师创作的重要方法。当建筑学进入现象学的领域，我们便再次意识到当代建筑学中面临的三个困境：一为“历史之轻”；二为“知觉之弱”；三为“主体之死”。“历史之轻”关于时间与记忆，“知觉之弱”关于直觉与物质性， “主体之死”关于身体性。如果我们以现象学的方式追问，这三个问题便成为：在当代建筑中，作为人类世界历史感之体现的记忆是否存在以及如何存在？作为人类知觉之体现的建筑物质性是否存在以及如何呈现？以及作为主体的身体是否依然存在于建筑之中以及如何存在于建筑之中？这便是本文探讨的三个主题。

建筑学的永恒使命是去创造能体现人类存在的物化隐喻，建构人类生存于斯的存在。正如阿尔多·罗西（Aldo Rossi）在《城市建筑学》（Architecture of City）中说道：“不同的时间和空间观念与我们的历史文化息息相关，因为我们生活在我们自己营建的地景之中，并且，无论在任何情况下都以之为参照”。[37]如果有一天在我们广褒大地之中，建筑师唤醒了人们的共同记忆——如同阿尔多·罗西所说的集体记忆，那么我们便找到了一条路，一条经由现象学通向刻有记忆印痕的未来之路。

注释：
[1] 施皮格伯格在《现象学运动》中，在定义现象学时提供了四种划分：最广义的现象学/广义的现象学/严格意义上的现象学/最严格意义上的现象学（《现象学运动》，41页）。根据中国学者倪梁康“略作改造”的后之解释，可以这样理解：施皮格伯格为现象学划分四个不同范围：1、最广义的现象学：符合现象学的公认标准，但主观上没有参加现象学运动的人。含布伦塔诺、斯通普夫等；2、广义的现象学：胡塞尔1913年设想和表述的方法意义上的现象学。含某一阶段的海德格尔、萨特，伽达默尔，某个时期的德里达；3、严格意义上的现象学：关注意识现象，尤为关注主观显现方式。含早期哥廷根学派、慕尼黑学派，舍勒、梅洛-庞蒂、古尔维奇等；4、最严格意义上的现象学：胡塞尔本人逐渐发展起来的现象学，“胡塞尔现象学”。本文使用的“现象学”，基本定义在上述第一种现象学上，即，最广义的现象学。
[2] Van Den Berg, J. H. (1914- ), Phenomenological Approach to Psychiatry, Psychology of the Sickbed.（转引自Gaston Bachelard , The Poetics of Space. Translated by Maria Jolas. New York: Orion Press, 1964; Boston: Beacon Press, 1969.）J. H. van den Berg, Ph. D., M. D.1914年生于荷兰，1946年毕业于Utrech University，专攻精神医学——神经病学，博士论文谈的是关于精神病学自体移植方法及其在精神分裂症方面的运用。自1951年起，陆续担任Utrech University、Duquesne University和南非大学等的学校的客座教授，并于1975年起，在美国、加拿大和南非等地巡回演讲。
[3] 塔可夫斯基（Andrei Tarkovsky，1932.4.4-1986.12.28），苏联著名导演、电影大师，代表作品有《伊万的童年》、《安德烈·鲁勃廖夫》、《镜子》、《潜行者》、《乡愁》等。
[4] 《安德烈·鲁勃廖夫》（Andrei Rublev），塔可夫斯基1966年作品，阿纳托里·索洛尼岑主演，获得戛纳电影节国际影评联合会奖，片长205分钟。
[5] 安德烈·鲁勃廖夫（Andrei Rublev，1360-1430），15世纪俄国东正教圣像派画家。
[6] 安德烈·巴赞（Andre Bazin，1918-1948），法国电影理论家，主编《电影手册》，被誉为“新浪潮电影之父”，主要著作：《电影是什么》四卷。
[7] 巴赞：《电影是什么》，99页，崔君衍译，中国电影出版社，1987。
[8] 塔可夫斯基：《导演艺术讲义》。见《导演艺术讲义》，李宝强编译：《七部半--塔可夫斯基的电影世界》，323页，中国电影出版社，2002。
[9] 《火车进站》，1895年，世界第一部公开放映的电影，片长半分钟。
[10] 塔可夫斯基：《雕刻时光》（Sculpting in Time），译自Juhani Palasmma, Space and Image in Tarkovsky's Nostalgia: Notes as a Phenomenology of Architecture. Alberto P巖ez-G梞ez and Stephen Parcell, Chora 1 (Montreal: McGill-Queen's University Press, 1994).
[11] 尤特凯维奇（Sergei Yutkevich）：《论电影艺术》。
[12] 胡塞尔（Edmund Husserl，1859-1938），德国哲学家，现象学运动的重要创始人之一，被认为是20世纪最重要的哲学家之一。主要著作《逻辑研究》、《纯粹现象学和现象学哲学的观念Ⅰ》、《生活世界现象学》以及生前未发表的《欧洲科学的危机与先验现象学》、《观念Ⅱ》等。
[13] 柏格森（Henri Bergson，1859-1941），法国哲学家，直觉主义和生命哲学的代表人物之一。主要著作《论意识的直接材料》（即英文版《时间与自由意志》，1889）、《创造进化论》（1907）。
[14] 法国新浪潮电影代表人物吕克·戈达尔（Jean-Luc Godard）提出的电影理论。
[15] 吉尔·德勒兹（Gilles Deleuze，1925－1995），法国哲学家、文学评论家。主要著作《尼采与哲学》、《重复与差异》、《千座高原》等。
[16] 德勒兹：《哲学与权利的谈判》，77页，商务印书馆，2000。
[17] 柏格森：《时间与自由意志》，160页，商务印书馆，2002。
[18] 柏格森：《时间与自由意志》，161页，商务印书馆，2002。
[19] 康德：《纯粹理性批判》62页，商务印书馆，1997。
[20] 康德：《纯粹理性批判》63页，商务印书馆，1997。
[21] 柏格森：《时间与自由意志》，62页，商务印书馆，2002。
[22] 柏格森：《时间与自由意志》，66页，商务印书馆，2002。
[23] 柏格森：《时间与自由意志》，66页，商务印书馆，2002。
[24] 梅洛-庞蒂（Maurice Merleau-Ponty，1908-1961），法国哲学家，被称为“法国最伟大的现象学家”，其主要著作为《知觉现象学》、《行为的结构》、《哲学赞词》、《眼与心》等。《知觉现象学》是法国第一部主题中标有“现象学”的系统研究著作。施皮格伯格在《现象学运动》中认为：在把现象学作为哲学这一点上，梅洛-庞蒂比大多数其他法国哲学家，包括萨特在内，都走得更远。
[25] 梅洛-庞蒂：《完善中的柏格森》，见《哲学赞词》，172页，商务印书馆，2000。
[26] 梅洛-庞蒂：《知觉现象学》（英文版名为：The Phenemeology of Perception，trans. By C. Smith），357页。
[27] 梅洛-庞蒂：《知觉现象学》（英文版名为：The Phenemeology of Perception，trans. By C. Smith），360页。
[28] 帕拉斯玛（Juhani Palasmma），芬兰建筑师、建筑理论家。帕拉斯玛主要研究建筑的现象学问题，其现象学理论依据主要源自于法国哲学家梅洛-庞蒂和加斯东·巴士拉（Gaston Bachelard，1884-1966）。
[29] 赫伯特·施皮格伯格：《现象学运动》，56页，王炳文等译，商务印书馆，1995。
[30] Juhani Palasmma, An Architecture of the Seven Senses. a+u, July 1994.
[31] Juhani Palasmma, An Architecture of the Seven Senses. a+u, July 1994.
[32] Alvar Aalto, Rationalism and Man, 1935.
[33] 约瑟夫·博依斯（J. Beuys, 1921-1986），德国艺术家，激浪派艺术代表人之一。
[34] 瓦尔特·本雅明（Walter Benjamin, 1892-1940），德国思想家，“西方马克思主义”美学的代表人物之一，被誉为欧洲真正的知识分子。
[35] 沃尔特·本雅明：《机器复制时代的艺术》。见《经验与贫乏》，268页，百花文艺出版社，1999。这里的“仪式”向“实践”转化，指的是艺术的社会功能发生变化，它不再建立在礼仪膜拜的基础上，而是建立在“政治”的根基上。
[36] 詹姆逊：《文化转向》，5页。詹姆逊所说“主体之死”指的是个性本身的终结，针对现代主义以个人、私人风格为创造的基础的结束而言。
[37] Aldo Rossi, Architecture of City. Cambridge: MIT Press 1982

参考文献
1. Alberto P巖ez-G梞ez and Stephen Parcell, Chora 1 (Montreal: McGill-Queen's University Press, 1994).
2. Juhani Palasmma, An Architecture of the Seven Senses (a+u, July 1994).
3. Juhani Palasmma, The Eyes of The Skin- Architecture and the Sense (London: Academy 1996).
4. Andrei Tarkovsky, Sculpting in Time (London: Bodley Head 1968).
5. Sigfried Giedion, Space,Time and Architecture (Cambridge, Mass: Harvard University Press 1997).
6. K. Michael Hays, Architecture Theory since 1968 (Cambridge, Mass: MIT Press 2000).
7. Henri Lefebvre, The Production of Space (Cambridge: Blackwell 1991).
8. Aldo Rossi, Architecture of City (Cambridge: MIT Press 1982).
9. Vittorio Gregotti, Inside Architecture (Cambridge: MIT Press 1996).
10. 柏格森：《时间与自由意志》，吴士栋译，商务印书馆，2002。
11. 康德：《纯粹理性批判》，蓝公武译，商务印书馆，1997。
12. 赫伯特·施皮格伯格：《现象学运动》，王炳文等译，商务印书馆，1995。
13. 伽达默尔：《现象学运动》，邓安庆译，载于：《伽达默尔集》，上海远东出版社，2003。
14. 梅洛-庞蒂：《知觉现象学》，姜志辉译，商务印书馆，2001。
15. 梅洛-庞蒂：《哲学赞词》，杨大春译，商务印书馆，2000。
16. 倪梁康编：《面对实事本身--现象学经典文选》，东方出版社，2000。
17. 安德烈·巴赞：《电影是什么？》，崔君衍译，中国电影出版社，1987。
18. 李宝强编译：《七部半--塔可夫斯基的电影世界》，中国电影出版社，2002。
19. 吉尔·德勒兹：《哲学与权利的谈判》，刘汉全译，商务印书馆，2000。
20. 詹姆逊：《文化转向》，胡亚敏等译，中国社会科学出版社，2000。

Logistic映射的LISP实现

highflybird — Thu, 04 Feb 2021 04:53:55 +0000

Logistic映射的LISP实现 highflybird 周四, 02/04/2021 - 12:53

关于Logistic映射，请参考集智百科词条：

Logistic映射

这里讲得很详细。我摘抄几句：

Logistic映射，又称单峰映象，是一个二次多项式映射(递归关系)，经常作为典型范例来说明复杂的混沌现象是如何从非常简单的非线性动力学方程中产生的。

生物学家罗伯特·梅 Robert May [1]在1976年的一篇论文中推广了这一映射，[2]它在一定程度上是一个时间离散的人口统计模型，类似于皮埃尔·弗朗索瓦·韦胡斯特 Pierre Francois Verhulst 首次提出的方程。

Logistic映射的数学表达式表示为:

\[\displaystyle{x(t+1)=\mu x(t)(1-x(t))}\]

美国物理学家费根鲍姆从中发现了费根鲍姆常数(第一常数），这是一个普适的常数，一个很重要的常数。

其大小 $ \delta \approx 4.66920 16091 02990 67185 32038 20466 20161 72581 85577 47576 86327 45651 34300 4134.....$

我用AutoLISP简单实现了logistic映射，代码如下：

;;; Logistic混沌映射的LISP实现
(defun Logistic (r x0  / i xn x)
  (setq i 0)
  (setq x x0)
  (while (and (< i 50) (not (equal x (setq xn (* r x (- 1 x))) 1e-8)))
    (setq x xn)
    (setq i (1+ i))
  )
  (entmakeX (list '(0 . "POINT") (list 10 r x 0)))
)
 
;;; 测试程序
(defun c:tt (/ r0 x0)
  (setq r0 0.0)
  (repeat 401
    (setq x0 1e-8)
    (repeat 1001
      (logistic r0 x0)
      (setq x0 (+ x0 0.001))
    )
    (setq r0 (+ r0 0.01))
  )
  (princ)
)

生成的图像大致如下：

更精美的图形可以用C++编写，下面是核心代码：

void Fractal::Logistic(int sx1,int sy1,int sx2,int sy2,CDC* pMemDC)
{
    double x(0),xx(0),y(0),yy(0),cx(0),cy(0);
    m_isBusy = true;
    for (int i = sx1; i <= sx2; i++)
    {
        for(int j = sy1;j <= sy2; j++)
        {
            x = cxmin+i*dx;
            y = cymin+j*dy;
            xx = x;
            yy = x*y*(1-y);
            int n = 0;
            while( fabs(y-yy) > 1e-14 && n < maxIter) 
            {
                y = yy;
                yy = x*y*(1-y);
                n++;
            }
            int k = (y-cymin)/dy;
            fPutPixel(i,k,n,H0,S0,L0,pMemDC,grad);
        }
    }
}

生成的图像：

利用DynamicWrapperX实现字符转换

highflybird — Mon, 25 Jan 2021 17:30:53 +0000

利用DynamicWrapperX实现字符转换 highflybird 周二, 01/26/2021 - 01:30

以下的代码需要DynamicWrapperX的支持。关于DynamicWrapperX的介绍，请看这个帖子：

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=172340&highlight=dynamicwrapper

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=85724&highlight=dynamicwrapper

最新版本是2.2.0，其下载地址是：

http://dynwrapx.script-coding.com/dwx/pages/dynwrapx.php?lang=en

利用它，可以用LISP实现字符的转换（包括简体转繁体，GB2312转BIG5,GBK等等）。

下面是其实现代码：

;|*************************************************************;
软件作者: Highflybird                                          ;
软件用途: 通过DynamicWrapperX插件实现汉字简繁转换(字符集转换)  ;
日期地点: 2016.05.14 深圳                                      ;
程序语言: AutoLISP,Visual LISP                                 ;
版本号:   Ver. 1.16.0514                                       ;
===============================================================;
================================================================
本软件为开源软件: 以下是开源申明:                               
----------------------------------------------------------------
本页面的软件遵照 GPL协议开放源代码，您可以自由传播和修改，在遵照
下面的约束条件的前提下:                                         
 
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明，保持
    此许可证的声明和没有担保的声明完整无损，并和程序一起给每个其
    他的程序接受者一份许可证的副本，你就可用任何媒体复制和发布你
    收到的原始程序的源代码。你也可以为转让副本的实际行动收取一定
    费用，但必须事先得到的同意。                                
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分，以此形
    成基于程序的作品。只要你同时满足下面的所有条件，你就可以按前
    面第一款的要求复制和发布这一经过修改的程序或作品。          
  1.你必须在修改的文件中附有明确说明：你修改了这一文件及具体的修
    改日期。                                                    
  2.你必须使你发布或出版的作品（它包含程序的全部或一部分，或包含
    由程序的全部或部分衍生的作品）允许第三方作为整体按许可证条款
    免费使用。                                                  
  3.如果修改的程序在运行时以交互方式读取命令，你必须使它在开始进
    入常规的交互使用方式时打印或显示声明: 包括适当的版权声明和没
    有担保的声明（或者你提供担保的声明）；用户可以按此许可证条款
    重新发布程序的说明；并告诉用户如何看到这一许可证的副本。（例
    外的情况: 如果原始程序以交互方式工作，它并不打印这样的声明，
    你的基于程序的作品也就不用打印声明。                        
三. 只要你遵循一、二条款规定，您就可以自由使用并传播本源代码，但
    必须原封不动地保留原作者信息。                              
================================================================
**************************************************************|;
 
;;;-------------------------------------------------------------
;;; 说明：此程序仅在简体中文系统中测试通过，繁体中文可能需做改变
;;;-------------------------------------------------------------
(defun C:test (/ DWX l1 l2 l3)
  (setq DWX (vlax-create-object "DynamicWrapperX"))
  (DWX:CharsetAPI DWX)
  ;(DWX:FileIO DWX)
  (setq l1 '("CAD简繁转化" DWX:GB2312->GBK DWX:GB2312->BIG5))
  (setq l2 '("CAD簡繁轉化" DWX:GBK->GB2312 DWX:GBK->BIG5))
  (setq l3 '("CAD虏羉锣て" DWX:BIG5->GBK DWX:BIG5->GB2312))
  (foreach n (list l1 l2 l3)
    (princ (strcat "\nBefore: " (car n)))
    (foreach f (cdr n)
      (princ (strcat "\nAfter " (vl-princ-to-string f) ": "))
      (princ (apply f (list DWX (car n))))
    )
  )
;;;  (if (setq Name (Getfiled "请选择文件" "c:/" "" 8))
;;;    (progn
;;;      (setq text (DWX:ReadTxt DWX Name nil))
;;;      (setq str1 (DWX:GB2312->BIG5 DWX text))
;;;      (setq file (open "C:\\CharConvert-tw.lsp" "w"))
;;;      (princ str1 file)
;;;      (close file)
;;;      (setq str2 (DWX:GB2312->GBK DWX text))
;;;      (setq file (open "C:\\CharConvert-HK.lsp" "w"))
;;;      (princ str2 file)
;;;      (close file)
;;;    )
;;;  )
  (vlax-release-object DWX)
  (princ)
)
 
;;;-------------------------------------------------------------
;;; GB2312->GBK 简体转繁体                                      
;;;-------------------------------------------------------------
(defun DWX:GB2312->GBK (DWX STR)
  (DWX:LCMapString DWX STR 67108864)				;67108864, LCMAP_TRADITIONAL_CHINESE
)
 
;;;-------------------------------------------------------------
;;; GBK->GB2312 繁体转简体                                      
;;;-------------------------------------------------------------
(defun DWX:GBK->GB2312 (DWX STR / nlen pStr)
  (DWX:LCMapString DWX STR 33554432)				;33554432, LCMAP_SIMPLIFIED_CHINESE
)
 
;;;-------------------------------------------------------------
;;; BIG5->GBK  BIG5转繁体                                       
;;;-------------------------------------------------------------
(defun DWX:BIG5->GBK (DWX str)
  (DWX:ANSI->Unicode DWX str 950)				;ANSI/OEM Traditional Chinese (Taiwan; Hong Kong SAR, PRC)
)
 
;;;-------------------------------------------------------------
;;; GBK->BIG5  繁体转BIG5                                       
;;;-------------------------------------------------------------
(defun DWX:GBK->BIG5 (DWX str)
  (DWX:Unicode->ANSI DWX str 950)				; Chinese Traditional (Big5)
)
 
;;;-------------------------------------------------------------
;;; GB2312->BIG5 简体转BIG5                                     
;;;-------------------------------------------------------------
(defun DWX:GB2312->BIG5 (DWX STR)
  (DWX:GBK->BIG5 DWX (DWX:GB2312->GBK DWX STR))
)
 
;;;-------------------------------------------------------------
;;; BIG5->GB2312 BIG5转简体                                     
;;;-------------------------------------------------------------
(defun DWX:BIG5->GB2312 (DWX STR)
  (DWX:GBK->GB2312 DWX (DWX:BIG5->GBK DWX STR))
)
 
 
;;;-------------------------------------------------------------
;;; JPN->GBK  日文转繁体                                        
;;;-------------------------------------------------------------
(defun DWX:JPN->GBK (DWX str)
  (DWX:ANSI->Unicode DWX str 932)				
)
 
;;;-------------------------------------------------------------
;;; GBK->JPN  繁体转日文                                        
;;;-------------------------------------------------------------
(defun DWX:GBK->JPN (DWX str)
  (DWX:Unicode->ANSI DWX str 932)				
)
 
;;;-------------------------------------------------------------
;;; For a locale specified by identifier,maps an input character
;;; string to another using a specified transformation, or      
;;; generates a sort key for the input string.                  
;;; 1024 -- LOCALE_USER_DEFAULT                                 
;;;-------------------------------------------------------------
(defun DWX:LCMapString (DWX STR MapFlags / nlen pStr)
  (setq nLen (vlax-invoke DWX 'LCMapStringW 1024 MapFlags str -1 0 0))
  (setq pStr (vlax-invoke DWX 'memAlloc (+ nLen nLen 2) 1))
  (setq nLen (vlax-invoke DWX 'LCMapStringW 1024 MapFlags str -1 pStr nLen))
  (setq str  (vlax-invoke DWX 'StrGet pStr "w"))
  (vlax-invoke DWX 'MemFree pStr)
  str
)
 
;;;-------------------------------------------------------------
;;; ANSI->Unicode  指定代码页转换为Unicode                      
;;;-------------------------------------------------------------
(defun DWX:ANSI->Unicode (DWX STR Code / nLen pStr)
  (setq nLen (vlax-invoke DWX 'MultiByteToWideChar Code 0 str -1 0 0))
  (setq pStr (vlax-invoke DWX 'memAlloc (+ nLen nLen 2) 1))
  (setq nLen (vlax-invoke DWX 'MultiByteToWideChar Code 0 str -1 pStr nLen))
  (setq str  (vlax-invoke DWX 'StrGet pStr "w"))
  (vlax-invoke DWX 'MemFree pStr)
  str
)
 
;;;-------------------------------------------------------------
;;; Unicode->ANSI  Unicode转换为指定代码页                      
;;;-------------------------------------------------------------
(defun DWX:Unicode->ANSI (DWX STR Code / nLen pStr)
  (setq nLen (vlax-invoke DWX 'WideCharToMultiByte Code 0 str -1 0 0 0 0))
  (setq pStr (vlax-invoke DWX 'memAlloc (1+ nLen) 1))
  (setq nLen (vlax-invoke DWX 'WideCharToMultiByte Code 0 str -1 pStr nLen 0 0))
  (setq str  (vlax-invoke DWX 'StrGet pStr "s"))
  (vlax-invoke DWX 'MemFree pStr)
  str
)
 
;;;-------------------------------------------------------------
;;; 注册字符集转换的API                                         
;;;-------------------------------------------------------------
(defun DWX:CharSetAPI (DWX)
  (vlax-invoke DWX 'Register "Kernel32" "MultiByteToWideChar" "i=llslpl" "r=l")
  (vlax-invoke DWX 'Register "Kernel32" "WideCharToMultiByte" "i=llwlplpp" "r=l")
  (vlax-invoke DWX 'Register "Kernel32" "LCMapStringA" "i=llslpl" "r=l")
  (vlax-invoke DWX 'Register "Kernel32" "LCMapStringW" "i=llwlpl" "r=l")
  (vlax-invoke DWX 'Register "Kernel32" "lstrlen" "i=p" "r=l")
)
 
(vl-load-com)

编程

用Javascript画图

highflybird — Mon, 25 Jan 2021 16:35:06 +0000

用Javascript画图 highflybird 周二, 01/26/2021 - 00:35

编程

垃圾文件清理工具

highflybird — Sun, 24 Jan 2021 03:56:16 +0000

垃圾文件清理工具 highflybird 周日, 01/24/2021 - 11:56

在工作中，我们需要清理一些在程序过程中产生的垃圾或者无需保留文件，但是因为不知情或者经常忘记的缘故，这些文件便积累起来，分布在各个目录中，难于查找和删除。特别是对于CAD作图的人来说，有时候形成一些.dwl, .plt, .err, .log, .ac$, .tmp等之类的文件，长期以来，既不美观，又浪费空间，的确有必要清理一下。而且下面这个程序可以帮你达到目的。网上有这样类似的程序，但可能比较庞杂，不会像这样针对特别目的。

程序截图：

CADCleaner

很久之前我就写了这个程序，开始时是用VLISP程序写的，后来我在学习VB的过程中，又把程序再次写了一遍，最后我用VC++重写。所以这个程序有三种版本的。这里我先发布VB语言的。

关于这个程序的源码我就不发布了，附件仅仅包含程序。这里贴出一段关键代码，就是用API 查找特定文件的代码：

'**********************************************************************************************************************
'查找函数
Public Function FindFilesAPI(path As String, SearchStr As Variant, FileCount As Long, DirCount As Long) As Double
    Dim FileName    As String           '文件名
    Dim Extension   As String           '文件后缀
    Dim DirName     As String           '子目录名
    Dim dirNames()  As String           '目录数组
    Dim nDir        As Long             '当前路径的目录数
    Dim i           As Long             '循环计数器变量
    Dim hSearch     As Long             '搜索句柄变量
    Dim WFD         As WIN32_FIND_DATA
    Dim Cont        As Long
 
    If Right(path, 1) <> chr(92) Then path = path & chr(92)
    '搜索子目录
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                '遍历目录并累计文件总数
                If GetFileAttributes(path & FileName) And FILE_ATTRIBUTE_DIRECTORY Then
                    dirNames(nDir) = FileName
                    DirCount = DirCount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                Else
                    If isCheckAll Or UserForm1.ZERO.Value And WFD.nFileSizeLow = 0 Then
                        If isCheckAll Then
                            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                        End If
                        FileCount = FileCount + 1
                        UserForm1.List1.AddItem path & FileName
                    Else
                        Extension = Mid(FileName, InStrRev(FileName, ".") + 1)
                        If CheckType(Extension, SearchStr) Then
                            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                            FileCount = FileCount + 1
                            UserForm1.List1.AddItem path & FileName
                            SendMessage LHwnd, WM_VSCROLL, SB_BOTTOM, 0&
                        End If
                    End If
                End If
            End If
            Cont = FindNextFile(hSearch, WFD)         '获取下一个文件或者文件夹
        Loop
        Cont = FindClose(hSearch)
    End If
    '如果子目录存在则遍历之
    If nDir > 0 And UserForm1.INC.Value Then
        For i = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & chr(92), SearchStr, FileCount, DirCount)
        Next i
    End If
End Function

VC版本的：

int CCADCleanerDlg::Search(CString PathName)
{
	CString FileName;
	HANDLE hScan=NULL;
	WIN32_FIND_DATAW FindFileData;
	if (PathName.Right(1) != (chr(92)))
	{
		hScan = FindFirstFile(PathName +_T("*"),&FindFileData);
	}
	else
	{
		hScan = FindFirstFile(PathName +_T("*"),&FindFileData);
	}
 
	if ( hScan != INVALID_HANDLE_VALUE)
	{
		BOOL cont = TRUE;
		while (cont)
		{
			FileName =  FindFileData.cFileName;
			if (FileName!=_T(".") && FileName!=_T(".."))
			{
				if (FindFileData.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY)
				{
					DirCount++;
					Search(PathName+FileName+chr(92));
				}
				else
				{
					if (Check(FileName,FindFileData.nFileSizeLow,FindFileData.nFileSizeHigh))
					{
						//m_strInfo = (PathName+FileName);
						m_list.AddString(PathName+FileName);
						//m_Info.SetWindowText(m_strInfo);
						//m_list.SendMessage(LB_ADDSTRING,NULL,(LPARAM)(FileName.GetBuffer()));
						//SendMessage(m_listWnd,LB_ADDSTRING,NULL,(LPARAM)(FileName.GetBuffer()));
						//m_list.SendMessage(WM_VSCROLL,SB_BOTTOM,NULL);
						FileCount++;
						if (FindFileData.nFileSizeHigh)
						{
							TotalSize += (FindFileData.nFileSizeLow + FindFileData.nFileSizeHigh * FOUR_GB);
						}
						else
						{
							TotalSize += FindFileData.nFileSizeLow;
						}
					}
				}
			}	
			cont = FindNextFile(hScan,&FindFileData);
		}
		FindClose(hScan);
		return TRUE;
	}
	else
	{
		return ERROR;
	}
}

截图：

CADCleaner(VC)
当然是用C语言编写的快些了。

简体繁体转换

highflybird — Sun, 24 Jan 2021 03:49:13 +0000

简体繁体转换 highflybird 周日, 01/24/2021 - 11:49

简体字和繁体字的互相转化程序，可用于CAD的文字处理。

以下是其实现代码：

;;;=============================================================
;;; 說明：此程序用于繁體字和簡體字的相互轉化，可以用于AutoCAD 的
;;;       字符。實際上簡體字和繁體字并不是一一對應的，有時候可能
;;;       一個簡體字對應多個繁體字，而繁體字一般來說只對應一個簡
;;;       體字。
;;;       程序中GB 碼是指的的中國大陸的簡體中文,GBK 碼是指的的香
;;;       港的繁體中文，BIG5是臺灣的繁體中文。如果應用于CAD 圖形
;;;       轉換，文字中出現問號或者亂碼，可能是由于沒有相應字體的
;;;       支持，請更換文字樣式。譬如:ChineseSet.shx,gbcbig.shx.
;;; 作者：Highflybird
;;; 日期：2013.01.23
;;; 修改：2013.04.20
;;; 地點：中國  深圳
;;;-------------------------------------------------------------
;;; 開源軟件，轉載請注明
;;;=============================================================
;;;=============================================================
;;; 首先確保你做了如下工作:(在winxp以上版本，可能需要管理員權限)
;;; 此函數為是否注冊了插件的檢查
;;; 用vlax-create-object 創建一個實例。用vlax-invoke調用其方法.
;;; 方法有: GB_GBK,GBK_GB,GB_BIG5,BIG5_GB,GBK_BIG5,BIG5_GBK等.
;;; 其功能顧名思義，如：GB_GBK就是把GB簡體轉化為GBK繁體。
;;;=============================================================
(defun Register (/ obj)
  (vl-load-com)
  (if (setq obj (vlax-create-object "CharConverter.Converter"))
    (vlax-release-object obj)
    (if (= (strlen (VL-PRINC-TO-STRING +)) 19)
      (startapp "regsvr32 /s "F:XCharConverter.dll"")     ;把這里面的路徑替換成自己的路徑
      (startapp "regsvr32 /s "F:XCharConverter.x64.dll"") ;如果是64位的系統
    )
  )
)
;;;=============================================================
;;; 功能：用對話框形式轉化兩岸三地的文字
;;;=============================================================
(defun C:DLG (/ Dialog)
  (setq Dialog (vlax-create-object "CharConverter.Dialog"))
  (if Dialog
    (progn
      (vlax-invoke Dialog 'doit)
      (vlax-release-object Dialog)
    )
  )
  (princ)
)
;;;=============================================================
;;; 功能：簡體字符串和繁體字符串互相轉化(此程序為LISP，無需插件)
;;; 輸入：字符串
;;; 輸出：被轉化后的字符串
;;;=============================================================
(defun Text:CharConvert (Converter IsRev text / Index NewTxt Str From to)
  (if IsRev
    (setq From TraditionalCharset
          To SimpleCharSet
    )
    (setq From SimpleCharSet
          To TraditionalCharset
    )
  )
  (setq NewTxt "")
  (while (/= text "")
    (setq str (substr text 1 1))
    (if (> (ascii str) 128)
      (progn
        (setq str (substr text 1 2))
        (setq text (substr text 3))
        (if (setq index (VL-POSITION str From))
          (setq str (nth index To))
        )
      )
      (setq str (substr text 1 1)
            text (substr text 2)
      )
    )
    (setq newtxt (strcat newtxt str))
  )
  newtxt
)
;;;=============================================================
;;; 功能：把含文字實體的CAD圖元進行簡繁轉換
;;; 輸入：含文字實體的CAD圖元
;;; 輸出：被轉化后的CAD圖元
;;;=============================================================
(defun ConvertEntity (Ent Converter How / dxf obj typ txt name blk TMPLST d)
  (setq dxf (entget ent))
  (setq obj (vlax-ename->vla-object ent))
  (setq Typ (cdr (assoc 0 dxf)))
  (cond
    ( (vlax-property-available-p obj 'textstring)               ;單行文字，多行文字，容差等等。
      (setq txt (vla-get-TextString obj))                       ;取得文字內容
      (vla-put-textstring obj (Func Converter How txt))         ;修改文字內容
      (if (= Typ "ATTDEF")
        (progn
          (setq txt (vla-get-tagstring obj))
          (vla-put-tagstring obj (Func Converter How txt))
        )
      )
    )
    ( (vlax-property-available-p obj 'TextOverride)             ;尺寸標注
      (setq txt (vla-get-TextOverride obj))                     ;取得文字內容
      (vla-put-TextOverride obj (Func Converter How txt))       ;修改文字內容
    )
    ( (= Typ "ACAD_TABLE")                                      ;表格
      (setq TMPLST  nil)
      (foreach n dxf                                            ;此處用DXF表(用vla方法比較啰嗦)
        (setq d (car n))
        (if (or (= d 1) (= d 3))
          (setq txt (Func Converter How (cdr n))                ;取得并修改文字內容
                TMPLST (cons (cons d txt) TMPLST)
          )
          (setq TMPLST (cons n TMPLST ))
        )
      )
      (entmod (reverse TMPLST))
      (vla-update obj)                                          ;需要更新一下
    )
    ( (= Typ "INSERT")                                          ;對于插入塊
      (foreach Att (vlax-invoke obj 'GetAttributes)
        (setq txt (vla-get-tagstring Att))
        (vla-put-tagstring Att (Func Converter How txt))
        (setq txt (vla-get-textstring Att))
        (vla-put-textstring Att (Func Converter How txt))
      )
      (setq name (vla-get-name obj))                            ;取得塊名
      (setq blk (vla-item *BLK name))
      (vlax-for n blk
        (ConvertEntity (vlax-vla-object->ename n) Converter How);遞歸進去，用于處理嵌套
      )
      (vla-update obj)                                          ;需要更新一下
    )
  )
)
;;;=============================================================
;;; 測試程序一，把一個文本文件里面的文字進行簡繁轉化
;;;=============================================================
(defun C:TT (/ BASE EXTN FILE KEY NAME OUTFILE PATH STR How OBJ LNG)
  (setq STR "(1)GB->GBK;(2)GBK->GB;(3)GB->BIG5;(4)BIG5->GB;(5)GBK->BIG5;(6)BIG5->GBK")
  (setq LNG (getvar 'locale))
  (cond
    ( (= LNG "CHS") (setq STR (strcat "请选择方式: " STR "<默认>")))
    ( (= LNG "CHT") (setq STR (strcat "叫匡拒よΑ: " STR "<纐粄>")))
    ( T (setq STR (strcat "請選擇方式: " STR "<默認>")))
  )
  (initget "1 2 3 4 5 6 S T")
  (setq key (getkword STR))
  (setq name (getfiled "Select a text File" (getvar 'DWGPREFIX) "*" 0))
  (if (and name (setq file (open name "R")))
    (progn
      (cond
        ( (= key "1") (setq How 'GB_GBK))
        ( (= key "2") (setq How 'GBK_GB))
        ( (= key "3") (setq How 'GB_BIG5))
        ( (= key "4") (setq How 'BIG5_GB))
        ( (= key "5") (setq How 'GBK_BIG5))
        ( (= key "6") (setq How 'BIG5_GBK))
        ( (= key "S") (setq How nil))
        ( (= key "T") (setq How T))
        ( t (setq How 'GB_GBK))
      )
      (setq path (vl-filename-directory name))
      (setq extn (vl-filename-extension name))
      (setq base (vl-filename-base name))
      (and (null extn) (setq extn ""))
      (setq outfile (open (strcat path "" base "轉" extn) "w"))
      (setq obj (vlax-create-object "CharConverter.converter"))
      (while (setq str (read-line file))
        ;;(setq str (Text:CharConvert nil How str))            ;如果你不用插件，可以用此方式
        (setq str (vlax-invoke obj How str))
        (write-line str Outfile)
      )
      (close outfile)
      (close file)
      (vlax-release-object obj)
      (princ)
    )
  )
)
;;;=============================================================
;;; 測試程序二，把選中的CAD文本簡繁轉化(需要先注冊插件)
;;; 當然你也可稍加修改，就能把標注，表格，及符號表的說明等轉化。
;;;=============================================================
(defun C:Test (/ i key Sel Ent *DOC *BLK How CONVERTER LNG STR FUNC)
  (setq STR "(1)GB->GBK;(2)GBK->GB;(3)GB->BIG5;(4)BIG5->GB;(5)GBK->BIG5;(6)BIG5->GBK")
  (setq LNG (getvar 'locale))
  (cond
    ( (= LNG "CHS") (setq STR (strcat "请选择方式: " STR "<默认>")))
    ( (= LNG "CHT") (setq STR (strcat "叫匡拒よΑ: " STR "<纐粄>")))
    ( T (setq STR (strcat "請選擇方式: " STR "<默認>")))
  )
  (initget "1 2 3 4 5 6 S T")
  (setq key (getkword STR))
  (if (setq sel (ssget '((0 . "*TEXT,INSERT,ATTDEF,TOLERANCE,DIMENSION,ACAD_TABLE"))))
    (progn
      (cond
        ( (= key "1") (setq How 'GB_GBK))
        ( (= key "2") (setq How 'GBK_GB))
        ( (= key "3") (setq How 'GB_BIG5))
        ( (= key "4") (setq How 'BIG5_GB))
        ( (= key "5") (setq How 'GBK_BIG5))
        ( (= key "6") (setq How 'BIG5_GBK))
        ( (= key "S") (setq How nil))
        ( (= key "T") (setq How T))
        ( t (setq How 'GB_GBK))
      )
      (setq *DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
      (setq *BLK (vla-get-blocks *DOC))
      (setq Converter (vlax-create-object "CharConverter.converter"))
      (if Converter
        (setq Func vlax-invoke)                                 ;如果加載了插件，則可以用invoke方式
        (setq Func Text:CharConvert)                            ;實際上此處函數可自定，不僅是簡繁轉換
      )
      (vla-StartUndoMark *DOC)
      (setq i 0)
      (repeat (sslength sel)
        (setq ent (ssname sel i))
        (ConvertEntity Ent converter How)
        (setq i (1+ i))
      )
      (vla-EndUndoMark *DOC)
      (vlax-release-object converter)
      (vlax-release-object *DOC)
      (princ "n轉化完畢，請驗證!")
    )
  )
  (princ)
)
;;;=============================================================
;;;漢字轉化字符表
;;;=============================================================
;;;=============================================================
;;; 以下程序用于格式化簡繁字庫
;;; 如果你想要添加本程序中沒有的字庫，請按照一一對應的方式添加
;;;=============================================================
(defun C:FormatSet (/ A1 A2 F1 F2 F3 F4 I L1 L2 S1 S2)
  (setq f1 (open "f:zqylsp簡體字.txt" "R"))
  (setq f2 (open "f:zqylsp繁體字.txt" "R"))
  (setq f3 (open "f:zqylspSimpleList.txt" "w"))
  (setq f4 (open "f:zqylspTraditionalList.txt" "w"))
  (setq i 0)
  (setq l1 nil)
  (while (setq s1 (read-line f1))
    (while (/= (setq a1 (substr s1 1 2)) "")
      (and (zerop (rem i 20)) (princ "n" f3))
      (princ (vl-string->list a1) f3)
      (setq l1 (cons a1 l1))
      (setq s1 (substr s1 3))
      (setq i (1+ i))
    )
  )
  (setq i 0)
  (setq l2 nil)
  (while (setq s2 (read-line f2))
    (while (/= (setq a2 (substr s2 1 2)) "")
      (and (zerop (rem i 20)) (princ "n" f4))
      (princ (vl-string->list a2) f4)
      (setq l2 (cons a2 l2))
      (setq s2 (substr s2 3))
      (setq i (1+ i))
    )
  )
  ;(setq l1 (ACAD_STRLSORT l1))
  ;(setq l2 (ACAD_STRLSORT l2))
  (close f1)
  (close f2)
  (close f3)
  (close f4)
  (princ)
)
;;;下面代碼用于測試
;;;(MISC:Test 1000 '( (Text:CharConvert txt IsRev) (vlax-invoke Converter How txt)))
(defun C:test2 (/ f obj)
  (setq obj (vlax-create-object "CharConverter.converter"))
  (vlax-invoke obj 'BIG5_GB "い地チ㎝瓣")
  (vlax-invoke obj 'GBK_BIG5 "中華人民共和國")
  (vlax-invoke obj 'GB_GBK "中华人民共和国")
  (vlax-invoke obj 'GBK_GB "中華人民共和國")
  (vlax-invoke obj 'BIG5_GBK "い地チ㎝瓣")
  (vlax-invoke obj 'GBK_BIG5 "中華人民共和國")
  (setq f (open "d:/temp/1.txt" "W"))
  (write-line (vlax-invoke obj 'GB_Big5 "中华人民共和国") f)
  (close f)
  (vlax-release-object obj)
)
;;; 注冊加載
(Register)
(princ "nTT   --轉換文本文件,nTest --轉換含文本的CAD圖元,nDLG  --對話框形式轉換.這幾個命令可自行修改.")
(princ)

曲线的转弯半径和曲率

highflybird — Sun, 24 Jan 2021 03:39:13 +0000

曲线的转弯半径和曲率 highflybird 周日, 01/24/2021 - 11:39

在下面的这个帖子中讨论了椭圆的曲率和转弯半径
http://bbs.mjtd.com/thread-62980-1-1.html
现在我把这个主题深化一下，讨论一下曲线的两个函数:
vlax-curve-getSecondDeriv
vlax-curve-getFirstDeriv
这两个函数是什么意思呢？
我们考察AutoCAD里面的曲线类，主要是圆，椭圆，弧和样条曲线，多段线由这几种组合而成。
椭圆和样条曲线实际上都是由参数形成，因此，对于这类曲线，它们每点的坐标可以由参数方程表达：
譬如椭圆 x=a*cos(t); y=b*sin(t);
样条曲线也有方程，假设样条曲线的参数方程为： X= f(t);
Y=g(t);
因此可以对参数方程求导，得到每一点的切线矢量，曲线上每一点对应于一个参数 t0 ,
这个切线矢量的的X值就是 f(t)在t0处的一阶导数，Y值就是g(t)在t0处的一阶导数，
即( f'(t0), g'(t0),0)
因而我们就理解了vlax-curve-getFirstDeriv 函数返回值的意义，
对于vlax-curve-getSecondDeriv的意义类似，只不过这次换成了二阶导数。
即( f''(t0), g''(t0),0)

那么如何求样条曲线或者椭圆的每一点的曲率及其半径呢？
根据参数方程的求曲率公式，若曲线由下面参数方程给出:
\[\left\{\begin{array}{l}x=\varphi(t) \\ y=\psi(t) \end{array}\right.\]
那么曲率如何计算?提示:
\[K=\frac{\left|\varphi^{\prime}(t) \psi^{\prime \prime}(t)-\varphi^{\prime \prime}(t) \psi^{\prime}(t)\right|}{\left[\varphi^{\prime 2}(t)+\psi^{\prime 2}(t)\right]^{3 / 2}}\]
下面是求值代码：

;;;=============================================================
;;;功能: 获取椭圆上一点处的曲率和离心半径（适用于单次利用此法）
;;;参数: 椭圆实体和椭圆上的一点
;;;返回: 此处离心圆圆心、离心半径及其曲率（离心率）
;;;说明: 如果要在CAD中几何作图，可以参考此贴：
;;;      http://bbs.mjtd.com/thread-62980-1-1.html
;;;=============================================================
(defun ELL:GetCurvature (en pt / obj a b px x y v1 v2 rad cen)
  (setq obj (vlax-ename->vla-object en))
  (setq a   (vla-get-MajorRadius obj))                          ;椭圆的半长轴
  (setq b   (vla-get-MinorRadius obj))				;椭圆的半短轴
  (setq pt  (vlax-curve-getclosestpointto en pt))		;保证此点在椭圆上
  (setq px  (vlax-curve-getParamAtPoint en pt))			;此点的椭圆参数
  (setq v1  (vlax-curve-getFirstDeriv en px))			;此点的一阶矢量
  (setq v2  (list (- (cadr v1)) (car v1) (caddr v1)))		;此点的切线矢量
  (setq x   (* a (sin px)))
  (setq y   (* b (cos px)))
  (setq rad (/ (expt (+ (* x x) (* y y)) 1.5) (* a b)))		;得到转弯半径
  (setq cen (polar pt (angle '(0 0 0) v2) rad))			;圆心
  (list cen rad)						;圆心及半径
)
;;;=============================================================
;;; 利用参数方程的求椭圆的曲率及其离心半径（适用于多次利用此法）
;;; 功能: 获取椭圆上一点处的转弯半径和离心圆圆心
;;; 参数: 椭圆实体和曲线上的一点
;;; 返回: 此处离心圆圆心、离心半径
;;;=============================================================
(defun ELL:GetCurvature1 (en a b pt / px v1 v2 x y rad cen)
  (setq pt  (vlax-curve-getclosestpointto en pt))		;保证此点在椭圆上
  (setq px  (vlax-curve-getParamAtPoint en pt))			;此点的椭圆参数
  (setq v1  (vlax-curve-getFirstDeriv en px))			;此点的一阶矢量
  (setq v2  (list (- (cadr v1)) (car v1) (caddr v1)))		;此点的切线矢量
  (setq x   (* a (sin px)))
  (setq y   (* b (cos px)))
  (setq rad (/ (expt (+ (* x x) (* y y)) 1.5) (* a b)))		;得到转弯半径
  (setq cen (polar pt (angle '(0 0 0) v2) rad))			;圆心
  (list cen rad)						;圆心及半径
)
;;;=============================================================
;;; 一般平面曲线参数方程的曲率离心公式
;;; 功能: 获取曲线上一点处的离心半径和离心圆圆心
;;; 参数: 曲线实体和曲线上的一点
;;; 返回: 此处离心圆圆心、离心半径
;;;=============================================================
(defun CUR:GetCurvature (en pt / ob px v1 v2 v3 x1 y1 x2 y2 cen rad d1 d2)
  (setq ob (vlax-ename->vla-object en))
  (setq pt (vlax-curve-getclosestpointto en pt))                ;保证此点在曲线上
  (setq px (vlax-curve-getParamAtPoint en pt))                  ;此点的曲线参数
  (setq v1 (vlax-curve-getFirstDeriv en px))                    ;此点的一阶矢量
  (setq v2 (vlax-curve-getSecondDeriv en px))			;此点的二阶矢量
  (setq v3 (list (- (cadr v1)) (car v1) (caddr v1)))            ;此点的切线矢量
  (setq x1 (car  v1))                                           ;一阶导数的 X值
  (setq y1 (cadr v1))						;一阶导数的 Y值
  (setq x2 (car  v2))						;二阶导数的 X值
  (setq y2 (cadr v2))						;二阶导数的 Y值
  (setq d1 (expt (+ (* y1 y1) (* x1 x1)) 1.5))
  (setq d2 (- (* x1 y2) (* x2 y1)))				;转弯内外的判定
  (if (/= d2 0)                                                 ;如果不为直线段
    (progn
      (setq rad (/ d1 d2))
      (if (vlax-method-applicable-p ob 'GetBulge)               ;如果为多段线(含圆弧)
	(if (< (vla-GetBulge ob (fix px)) 0)			;如果此段凸度小于0
	  (setq rad (- rad))
        )
      )
      (list (polar pt (angle '(0 0 0) v3) rad) (abs rad))	;圆心及半径
    )
  )
)

一些测试代码：

;;;=============================================================
;;;测试程序1: 获取曲线一点处的曲率和离心半径
;;;=============================================================
(defun c:tt1 (/ ent pnt ret)
  (setq ent (car (entsel "\n请选取曲线:")))
  (while (setq pnt (getpoint "\n点取一点"))
    (setq pnt (trans pnt 1 0))
    (setq pnt (vlax-curve-getclosestpointto ent pnt))
    (setq ret (CUR:GetCurvature ent pnt))
    (princ "\n离心半径是:")
    (princ ret)
    (and ret (apply 'Ent:Make_Circle ret))
  )
  (princ)
)
;;;=============================================================
;;;测试程序2: 获取椭圆一点处的曲率和离心半径，并比较两种方法
;;;=============================================================
(defun c:tt2 ( / ent obj a b pnt par 1st 2st r1 r2 r3)
  (if (and (setq ent (car (entsel "\n请选取椭圆:")))
	   (setq obj (vlax-ename->vla-object ent))
	   (vlax-property-available-p obj 'MajorRadius)		;这个地方应该加出错处理
  	   (setq a (vla-get-MajorRadius obj))
	   (setq b (vla-get-MinorRadius obj))
      )
    (while (setq pnt (getpoint "\n点取一点:"))
      (setq pnt (trans pnt 1 0))
      (setq pnt (vlax-curve-getclosestpointto ent pnt))
      (setq par (vlax-curve-getparamatpoint ent pnt))
      (setq 1st (vlax-curve-getFirstDeriv ent par))
      (setq 2st (vlax-curve-getSecondDeriv ent par))
      (setq r1  (distance '(0 0) 2st))                          ;这个secondDeriv并不意味着半径
      (setq r2  (cadr (ELL:GetCurvature1 ent a b pnt)))
      (setq r3  (cadr (CUR:getcurvature ent pnt)))
      (princ "\nRadius 1 is:")
      (princ r1)
      (princ "\nRadius 2 is:")
      (princ r2)
      (princ "\nRadius 3 is:")
      (princ r3)
      (UTI:Bench
        10000
        (list
	  (list 'ELL:GetCurvature1 ent a b pnt)
	  (list 'CUR:getcurvature ent pnt)
        )
      )
    )
  )
)
;;;=============================================================
;;;测试程序3: 动态演示曲线的离心半径
;;;=============================================================
(defun c:tt3 (/ CIR ENT LIN PNT PT0 RET 1ST 2ST CEN PAR PT2 VEC)
  (setq ent (car (entsel "\n请选取曲线:")))
  (setq cir (Ent:Make_Circle '(0 0 0) 1))
  (setq lin (ent:make_Line '(0 0 0) '(0 0 0)))
  (setq vec (ent:make_Line '(0 0 0) '(0 0 0)))
  (setq lin (vlax-ename->vla-object lin))
  (setq vec (vlax-ename->vla-object vec))
  (setq cir (vlax-ename->vla-object cir))
  (vla-put-color lin 1)
  (vla-put-color cir 3)
  (vla-put-color vec 6)
  (princ "\n按空格或者回车退出!")
  (while (= (car (setq pt0 (grread 5 0))) 5)
    (setq pnt (trans (cadr pt0) 1 0))
    (setq pnt (vlax-curve-getclosestpointto ent pnt))
    (setq par (vlax-curve-getparamatpoint ent pnt))
    (setq 1st (vlax-curve-getFirstDeriv ent par))
    (setq 2st (vlax-curve-getSecondDeriv ent par))
    (if (setq ret (CUR:GetCurvature ent pnt))
      (progn
	(setq pt2 (mapcar '+ pnt 2st))
	(setq cen (car ret))
        (vlax-put Cir 'Center cen )
        (vlax-put cir 'Radius (cadr ret))
        (vlax-put lin 'StartPoint cen)
        (vlax-put lin 'EndPoint pnt)
	(vlax-put vec 'StartPoint pt2)
        (vlax-put vec 'EndPoint pnt)
      )
    )
  )
  (vla-erase cir)
  (vla-erase lin)
  (vla-erase vec)
  (princ)
)
;;;=============================================================
;;;测试程序4: 由曲线的离心半径描绘其轨迹
;;;=============================================================
(defun c:tt4 (/ ent lst par px1 px2 pxn pnt Inf cen)
  (if (setq ent (car (entsel "\n请选取曲线:")))
    (progn
      (setq px1 (vlax-curve-getStartParam ent))
      (setq px2 (vlax-curve-getendparam ent))
      (setq pxn (* (- px2 px1) 0.02))
      (setq par px1)
      (while (<= par px2)
        (setq pnt (vlax-curve-getpointatparam ent par))
        (setq Inf (CUR:GetCurvature ent pnt))
        (if (setq cen (car Inf))
	  (setq lst (cons cen lst))
	)
        (setq par (+ par pxn))
      )
      (setq lst (reverse lst))
      (Ent:Make_LWPoly lst 1)
    )
  )
)

小问题，大思考

highflybird — Sun, 24 Jan 2021 03:28:07 +0000

小问题，大思考 highflybird 周日, 01/24/2021 - 11:28

一个博士朋友的儿子刚上初中不久，他就提出了下面的一个问题，我感觉很有深度，很难得，现在贴出来说说。

如下面图所示：已知线段AB和一点P，n等分线段,得到n+1个点与P连线。

问：n趋于无穷大时，这些连线长的平均值趋向一个定数吗？如果是，该怎样求？

粗看起来好像没什么难度，然而稍微计算一下，就发现不那么简单，博士拿出了Maple这个数学软件，用求极限法得到了一个并不简单的结果：

后来，我觉得这个极限可以化为积分，得到了相同的结果：

其中的字母含义如下：

这个结果显然不是初中的知识了。

这个小孩很有天赋，他还把这个问题做引申发散开来。

首先，他问这样的平均距离除了对直线有外，对圆也有么？

我开始用积分算了一下，得到一个巨复杂的结果：

后来稍微优化了一下，

但可以看出，这已经不是可以用初等函数来表达的了，已经用了椭圆积分来表达了。然后，他又继续问了一个问题，在一个三角形内，是否存在这样的一个点，使得点到这三条线段的上述平均值相等？

在我看来，一般情况下存在这个点，原因如下：
因为一点(x,y)到线段的平均值的积分解是一个与x,y有关的二元函数
因此另 p1p2的值设为f1(x,y), p2p3的值设置为f2(x,y),p3p1的值设置为f3(x,y)
显然有 f1(x,y)=f2(x,y); f2(x,y)=f3(x,y)
这是一个二元方程组，应该有一个解，但估计无法用公式求解，只能数值求解了。

下面贴出一些LISP代码来验证求解。

(defun ALG:AverageLength (p p1 p2 / A A1 A2 A3 A4 H HH L RT V)
  (setq L (distance p1 p2))
  (setq v (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
  (setq h (abs (car v)))
  (setq a (- (caddr v)))
  (if (> L 0)
    (progn
      (setq a (/ a L))
      (setq h (/ h L))
      (setq hh (* h h))
      (setq a1 (+ (* a a) hh))
      (setq a2 (+ a1 a a 1))
      (setq a3 (sqrt a1))
      (setq a4 (sqrt a2))
      (if (equal hh 0 1e-8)
	(setq rt (+ (* a (- a4 a3)) a4))
        (setq rt (+ (* a (- a4 a3))
		    (* hh (- (log (+ a 1 a4)) (log (+ a a3))))
		    a4
	         )
        )
      )
      (setq rt (* 0.5 rt L))
    )
    (distance p p1)
  )
)
 
;(1/2)*a*sqrt(a^2+h^2)-(1/2)*h^2*ln(-a+sqrt(a^2+h^2))+(1/2)*b*sqrt(b^2+h^2)+(1/2)*h^2*ln(b+sqrt(b^2+h^2))
;;;采用积分法
(defun ALG:AverageLength2 (p p1 p2 / A AH B BH H HH L V rt)
  (setq L (distance p1 p2))
  (setq v (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
  (setq h (abs (car v)))
  (setq a (caddr v))
  (setq b (- L a))
  (if (equal L 0 1e-8)
    (distance p p1)
    (if (equal h 0 1e-8)
      (/ (+ (* a a) (* b b)) 2 L)
      (setq a  (/ a L)
	    b  (/ b L)
	    h  (/ h L)
	    hh (* h h)
	    ah (sqrt (+ (* a a) hh))
	    bh (sqrt (+ (* b b) hh))
	    rt (* hh (log (/ (+ b bh) (- ah a))))
            rt (* 0.5 L (+ RT (* a ah) (* b bh)))
      )
    )
  )
)
 
;;;收敛很慢
(defun ALG:AverageLength1 (p p1 p2 / A AV D H HH I L N S UN V X)
  (setq L (distance p1 p2))
  (setq v (trans (mapcar '- p p1) 0 (mapcar '- p2 p1)))
  (setq h (abs (car v)))
  (setq a (- (caddr v)))
  (if (> L 0)
    (progn
      (setq n 1000)
      (setq i 0)
      (setq s 0)
      (setq hh (* h h))
      (setq un (/ L n))
      (repeat (1+ n)
	(setq x (+ a (* i un)))
        (setq d (sqrt (+ (* x x) hh)))
	(setq s (+ s d))
	(setq i (1+ i))
      )
      (setq av (/ s (1+ n)))
    )
    (distance p p1)
  )
)
 
(defun ALG:AverageLengthOfCircle (p c r / A D I L N U X Y)
  (setq p (mapcar '- p c))
  (setq i 0)
  (setq l 0)
  (setq n 36000)
  (setq u (/ pi n))
  (repeat n
    (setq a (/ i u))
    (setq x (* r (cos a)))
    (setq y (* r (sin a)))
    (setq d (distance p (list x y)))
    (setq l (+ d l))
    (setq i (1+ i))
  )
  (/ l n)
)
 
(defun c:xx ()
  (initget 9)
  (setq p (getpoint "\n直线外一点:"))
;;;  (initget 9)
;;;  (setq c (getpoint "\n圆心:"))
;;;  (initget 15)
;;;  (setq r (getdist C "\n半径:"))
  (setq c '(0 0))
  (setq r 1)
  (setq z (ALG:AverageLengthOfCircle p c r))
  (princ "\n所求的值为: ")
  (princ (rtos z 2 20))
  (princ)
)
 
(defun c:gg ()
  (setq i 0)
  (setq p0 '(0 0))
  (setq l 0)
  (setq x 0)
  (setq n 1000000)
  (setq u (/ 1.0 n))
  (repeat n
    (setq y (cos x))
    (setq d (distance p0 (list x y)))
    (setq l (+ l d))
    (setq x (* i u))
    (setq i (1+ i))
  )
  (setq v (/ l n))
  (princ "\n所求的值为: ")
  (princ (rtos v 2 20))
  (princ)
)
 
(defun c:ccc()
  (initget 9)
  (setq p (getpoint "\n直线外一点:"))
  (setq p (trans p 1 0))
  (initget 9)
  (setq p1 (getpoint "\n直线第一点:"))
  (setq p1 (trans p1 1 0))
  (initget 9)
  (setq p2 (getpoint "\n直线第一点:"))
  (setq p2 (trans p2 1 0))
  (setq x (ALG:AverageLength p p1 p2))
  (princ (strcat "\n所求的平均值是:" (rtos x 2 20)))
  (setq x1 (ALG:AverageLength1 p p1 p2))
  (princ (strcat "\n极限法所求的平均值是:" (rtos x1 2 20)))
 
  (setq x2 (ALG:AverageLength2 p p1 p2))
  (princ (strcat "\n积分法所求的平均值是:" (rtos x2 2 20)))
 
;;;  (UTI:BENCH 1000
;;;    (list
;;;      (list 'ALG:AverageLength p p1 p2)
;;;      (list 'ALG:AverageLength1 p p1 p2)
;;;    )
;;;  )
 
  (princ)
)

有兴趣的不妨测试一下。

CAD问题小百科

highflybird — Sun, 24 Jan 2021 03:14:52 +0000

CAD问题小百科 highflybird 周日, 01/24/2021 - 11:14

我是搬运工：

从这里摘录了一些常见的CAD小问题：

https://www.cnblogs.com/JJBox/p/10848766.html

一、词典问题集合
这是一个常见的问题。
先说解决方案:
方法1：可以用删除词典的方法:

(dictremove(namedobjdict)"ACAD_DGNLINESTYLECOMP")

方法2：
如果你有用源泉建筑插件可以用pua命令也可以用桌子带有的工具,
点我
方法3：
另存R14格式，再保存成你的版本。
关闭之后再次打开，保存，速度变快。(尝试清理词典)

高版本貌似pu就有选项了就可以了...

这个问题症状如下:
1、CAD保存慢:
2、cad很多线型!(尝试清理词典)CAD不能粘贴，出现_pasteclip:
3、dgn线型的问题,天正也会导致这个问题(尝试清理词典)
4、在无天正的CAD状态下打开含有天正图元的DWG,装上天正,然后转旧版本;
5、CAD每次保存都会出现这个： *警告* 多重从属对象，句柄“FXXXXX”;(尝试清理词典)

二、注册问题

cad 打开就闪退用Everything搜索删除 flexnet 目录下所有文件,这是由于注册文件导致的...需要重新注册...
cad2012~CAD2017打开慢,在注册表编辑器中找到下面位置:
HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R18.2\ACAD-A005:804\InfoCenter\InfoCenterOn 然后把值改为0
也可能是默认打印机设置为网络打印机,网络打印机关机了,检索不到,造成缓慢...代码的结局方案可以看我另一篇代码解决网络打印机的问题:博文

三、权限问题
win10禁止拖拉程序到绘图区?
运行regedit,注册表 HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA
然后把值改为0
但是我告诉你...会导致win10的商店用不了..貌似内置应用也用不了..你可能是正版家庭版win用户，建议更换专业版。。。
win10的cad用ctrl+q会是_copyclip
把一个cad改成兼容性win7执行就可以了...但是貌似治标不治本,形而上学啊....万一兼容性会导致某些问题呢....
你可能是正版受害者.....
CAD搜索报错，高版本ctrl+u弹界面
CAD因为会搜索当前dwg路径的所有文件,如果dwg在桌面,那么快捷方式无效会导致报错.
说实话没找到解决方案，桌子为什么那么蛋疼做这个东西...

四、CAD界面跳动
Statusbar,autowrap,0 ;2018关闭命令栏跳动(跳动也可以去关闭坐标显示)

五、CAD操作问题
属性名称不能相同，做成属性块之后会红字显示,并且用ATTSYNC更新时候会出错，拉伸属性的时候会出错.
有时候在位编辑之后,保存在位编辑了,可是参照面板无法动了,这个时候只要保存一下,然后ctrl+z,就可以解决了..蛮神奇的...
代码的话看我另一篇win32打开参照面板的博文的主函数上面,
原理就是发送命令,无他...有知道原因的告诉我一下..

六、复制粘贴问题
症状1: cad2008复制粘贴就崩溃但是高版本不会,可能是天正电气的一个bug导致的.
症状2: 之前也试过，用高版本的CAD清理了之后，就可以,画了一些东西之后就又不行了.
解答: 要重新用最新版的天正和其匹配的cad进行转旧出来.

七、CAD安装问题
cad2007遇到了这种情况
安装问题安装CAD出现C++2005问题的解决方法，出现此问题，
原因大部分就是因为安装路径目录或是下载的安装包有中文字体，导致电脑不能识别，只要把中文该成英文字母形式就可以了。
详见: cad2012安装的问题
cad2020安装时候出现1603安装失败:
运行,cmd,输入:"C:\Program Files (x86)\Common Files\Autodesk Shared\AdskLicensing\Current\AdskLicensingService\AdskLicensingService.exe"
CAD2020激活界面问题许可管理器不起作用或未正确安装
混合电源设置会影响Autodesk 2020产品许可
下载里面的Autodesk Licensing Service v9.0.3.46.zip
安装即可.
20190713:这个方法并不是很好,似乎是我使用了最新的win1903的最新更新导致? 因为我今天打开又遇到了...
20191205:开启此服务,注意是不是你的电脑管家或者360优化关闭了相关服务.
右击我的电脑-管理-服务与应用程序-服务

删除所有注册表,再安装开始-运行-输入“regedit”，打开注册表，找到下面的注册表路径：HKEY_LOCAL_MACHINE\SOFTWARE\Autodesk\AutoCAD\R18.0
右击鼠标删除 R18.0 整个键值。
找到下面的注册表路径：
HKEY_CORRENT_user\SOFTWARE\Autodesk\AutoCAD\R18.0
右击鼠标删除 R18.0 整个键值。
最后一步，也是最重要的，找到下面的注册表路径：
HKEY_LOCAL_MACHINE\SOFTWARE\Classes\installer\Products 的下面，
右击鼠标删除“7D2F38751008某某某”开头的键值，删除以后就可以重新安装了

八、图块编辑问题
很危险的问题****因为进块编辑器,编辑之后就退出,结果一卡,这个块把模型原有的图替代了,会丢失整个模型块表...
你的图要重画咯~~~~~~
画图记得备份,备份器c#的代码实现我公开在这里
某些人: Acad2014和浩辰2018....
瓦蓝: win7下Acad2012字体问题集合

九、字体问题
cad 两台电脑的宋体相同，但是一台电脑保存另一台出现问号,删除KT_ST.ttf,
更为详尽的说明和代码的解决方案
cad 高版本面板乱码,参照面板弹出之后,其他面板会乱码,删除所有cad支持目录的fonst文件夹中的.ttf .ttc之类的字体,
包括插件和cad自带目录,高版本不知道为什么桌子自带这样的问题,真的令人头痛.....
插入或者绑定外部参照出现文字偏移,请不要使用"新宋体.TTF",
详见点我
什么都不加载,启动cad时也乱码: 系统问题,区域改成新加坡重启后,可以加载了,再改回中国,应当就ok了。

十、多窗口问题
CAD一个程序中打开多个窗口设置：
1、命令行输入SDI，回车，输入0，回车。
2、点击工具条上“窗口”，再点击下面的选项。
3、选择不同的在同一窗口打开多个文件的方式。
4、打开cad工具栏中：工具-选项-系统-（去掉单文档兼容模式前面的勾），然后就好了。
5、在工具栏的空白处点右键，然后在“选项卡”前面打上对勾，就可以在同一个cad程序里面打开多个cad文件了。

十一、打印问题
打印cad用pdf factory的时候发生打印错误,
提示:内部错误:PrepareDispatcher was unable to launch the
发生在联网打印就不行,断网打印就可以...官网的bat我也下载了,也不行.......
解决:我先是升级win10到1903版本.....
升级工具
开心了一个小时之后,我做了局域网共享的操作之后,发现又出现了!所以我肯定了是共享文件夹的方式出现了问题,
经过查询之后,我发现了要设置防火墙允许通过的列表中:远程桌面,远程协助,远程关机,
这几个要关掉.貌似就是这几个导致的(只是貌似,因为我先运行了下面的.bat)文件和打印机共享、网络发现、SMBDirect上的文件和打印机共享这几个要开启.
之前这个仁兄写的是关闭防火墙的,我建议他打开防火墙,所以你们可以用这个工具的最新版来解决局域网共享:
局域网共享一键修复.bat

十二、杂项
1、cad 菜单选择打开文件的时候,等半天才出现文件打开对话框,点我
2、cad 复制中断产生的不可见图元,无法刷新,点我
3、怪事1，CAD在局域网联机工作,一直可以保存的,但是突然变成只读,但是直接关掉CAD会丢失了文件!
怪事2：CAD在本机工作或联机工作,保存出现错误,生成了文件,但是直接关掉CAD会丢失了文件!
以上似乎是win7的问题,局域网共享的问题,详细我已经没有测试条件了...建议换win10
在企业版win中,我发现了加载了自己的插件,然后闪退,致命错误...这就很不解了....换专业版
在家庭版win中,使用源泉,貌似会发生不可思议的加载失效事情....换专业版
4、选项卡预览关闭
将FILETABPREVIEW系统变量的值设为0，将显示方式变为列表，无法关闭预览
5、autocad打开时多个文件时任务栏也同时出现多个窗口的解决办法：
打开CAD；输入taskbar命令；CAD2011默认为1，改为0即可。

技巧

去教育版戳记讨论及源码(ARX,LISP版)

highflybird — Thu, 21 Jan 2021 14:02:26 +0000

去教育版戳记讨论及源码(ARX,LISP版) highflybird 周四, 01/21/2021 - 22:02

CAD教育版戳记有时候很讨厌，一旦图中有这个戳记，就会传染到其它图中。就是说从有戳记的图中拷贝到没戳记的，没戳记的也会带上。

而且这个戳记不太好消除。

对于2015-2018，Autodesk公司似乎已经把这个戳记移除掉了，也就是说，用这些版本的CAD打开图，看不到戳记，也不会弹出那个戳记警告框。

保存之后，图中不会再有了（这点我没有每个版本验证）。但该死的是到了2019后，这个又出现了，不知道autodesk公司在玩什么。

关于去教育版有很多方式，ARX的方式最有效。我这里提供用了ARX源码。以及附带的生成的ARX程序。

这个程序的源码是从网上的 wdzhangsl 引申过来，特此深表感谢！

程序的原理是从数据库指针找到戳记的偏移地址，修改此处的值，便达到了消除。

因为原代码有些重复和繁琐，特此精简，并且升级到2019。经过测试，程序有效。

因为有些CAD版本我是没办法在自己机器安装，就没有一个个CAD版本进行测试其中的偏移地址。

如果有网友能测试到我程序中没有的CAD版本的值，请告诉我或者跟帖。多谢！

下面是程序的源码和已经编译好二进制文件的压缩包。欢迎各位捉虫子和提出建议。

程序的用法是：加载后，程序会自动消除戳记，也可以用手动输入命令QJYB 来消除。

如果你把此程序加载到启动组，以后每当打开有教育版的dwg后，程序会自动消除，你需要做的仅仅是保存文件而已。

对于LISp版本，更有这两项突出功能：

1、消除打开戳记文件的错误警告框。

2、全面兼容各种CAD版本。

LISP的代码如下：（需要DynamicWrapperX支持）

;|*************************************************************;
软件作者: Highflybird                                          ;
软件用途: 消除CAD教育版戳记                                    ;
日期地点: 2019.05.12 深圳                                      ;
程序语言: AutoLISP,Visual LISP                                 ;
版本号:   Ver. 1.0.19.0512                                     ;
===============================================================;
================================================================
本软件为开源软件: 以下是开源申明:                               
----------------------------------------------------------------
本页面的软件遵照 GPL协议开放源代码，您可以自由传播和修改，在遵照
下面的约束条件的前提下:                                         
 
一. 只要你在本开源软件的每一副本上明显和恰当地出版版权声明，保持
    此许可证的声明和没有担保的声明完整无损，并和程序一起给每个其
    他的程序接受者一份许可证的副本，你就可用任何媒体复制和发布你
    收到的原始程序的源代码。你也可以为转让副本的实际行动收取一定
    费用，但必须事先得到的同意。                                
二. 你可以修改本开源软件的一个或几个副本或程序的任何部分，以此形
    成基于程序的作品。只要你同时满足下面的所有条件，你就可以按前
    面第一款的要求复制和发布这一经过修改的程序或作品。          
  1.你必须在修改的文件中附有明确说明：你修改了这一文件及具体的修
    改日期。                                                    
  2.你必须使你发布或出版的作品（它包含程序的全部或一部分，或包含
    由程序的全部或部分衍生的作品）允许第三方作为整体按许可证条款
    免费使用。                                                  
  3.如果修改的程序在运行时以交互方式读取命令，你必须使它在开始进
    入常规的交互使用方式时打印或显示声明: 包括适当的版权声明和没
    有担保的声明（或者你提供担保的声明）；用户可以按此许可证条款
    重新发布程序的说明；并告诉用户如何看到这一许可证的副本。（例
    外的情况: 如果原始程序以交互方式工作，它并不打印这样的声明，
    你的基于程序的作品也就不用打印声明。                        
三. 只要你遵循一、二条款规定，您就可以自由使用并传播本源代码，但
    必须原封不动地保留原作者信息。                              
================================================================
**************************************************************|;
(defun c:QJYB (/ acdb addr DWX flag hMod isOK name pEMR pFlag
	         hPROC Code CADVer OFFSET PID pNEW VMAP)
  (if (setq dwx (vlax-create-object "DynamicWrapperX"))
    (progn
      (DWX:Register DWX)
      (setq acdb (strcat "acdb" (substr (getvar "acadver") 1 2) ".dll"))
      (setq hMod (vlax-invoke DWX 'GetModuleHandle acdb))
      (if (Is64Bit)
	(setq Name "?isEMR@AcDbDatabase@@QEBA_NXZ"
	      pEMR (vlax-invoke DWX 'GetProcAddress hMod name)
	      vMap '((172 . "180B")
		     (180 . "800B")
		     (181 . "880B")
		     (182 . "900B")
		     (190 . "A80B")
		     (191 . "B00B")
		     (230 . "A00B")
		     (231 . "A00B")
		   )
	)
	(setq Name "?isEMR@AcDbDatabase@@QBE_NXZ"
	      pEMR (vlax-invoke DWX 'GetProcAddress hMod name)
	      vMap '((150 . "A406")
		     (160 . "D406")
		     (161 . "D406")
		     (162 . "D406")
		     (170 . "DC07")
		     (171 . "2408")
		     (172 . "3408")
		     (180 . "6C08")
		     (181 . "7408")
		     (182 . "7C08")
		     (190 . "8408")
		     (191 . "8408")
		     (230 . "8408")
		   )
	)
      )
      (setq CADVer (fix (* 10 (atof (substr (getvar "acadver") 1 4)))))
      (setq offset (cdr (assoc CADVer vMap)))
      (setq Func (read name))
      (if (zerop pEMR)
	(princ "\n你运行的CAD版本可能是2015-2018，它会自动消除教育版!")
	(if
	  (and
	    (/= 0 (setq pID (vlax-invoke DWX 'GetCurrentProcessId)))
            (/= 0 (setq hProc (vlax-invoke DWX 'OpenProcess 2035711 0 pID)))	;2035711 = PROCESS_ALL_ACCESS = 0x1F0FFF;
	  )
	  (progn
            ;(FindOffset DWX acdb name)
	    (if (Is64Bit)
	      (setq Code (strcat "488B490833C08981" offset "00003C00C3"))
	      (setq Code (strcat "8B490433C08981" offset "00003C00C3"))
	    )
	    (setq pFlag (vlax-invoke DWX 'MemAlloc 4))
	    (setq isOK (vlax-invoke DWX 'VirtualProtect pEMR 30 4 pFlag))	;PAGE_READWRITE = 0x4;
	    (if (/= isOK 0)
	      (setq pNew (vlax-invoke DWX 'MemWrite Code pEMR)
		    flag (vlax-invoke DWX 'NumGet pFlag)
		    isOK (vlax-invoke DWX 'VirtualProtect pEMR 30 flag pFlag)
	      )
	    )
	    (vlax-invoke DWX 'MemFree pFlag)
	    (vlax-invoke DWX 'CloseHandle hProc)
	    (if (zerop isOK)
	      (princ "\n程序运行失败!")
	      (princ "\n程序运行成功!")
	    )
	  )
	)
      )
    )
    (princ "\n你没有注册DynamicWrapperX!或者没有权限!")
  )
  (princ)
)
;;;=============================================================
;;; 功能: 检查CAD是否为64位。                                   
;;; 输入: 无。                                                  
;;; 输出: CAD如果是64位则返回T，否则返回nil。                   
;;;=============================================================
(defun Is64Bit ()
  (= 27 (strlen (VL-PRINC-TO-STRING +)))
)
 
;;;=============================================================
;;; 功能: 注册一些与内存相关函数                                
;;; 输入: DynamicWrapperX对象。                                 
;;; 输出: 无。                                                  
;;;=============================================================
(defun DWX:Register (DWX)
  (vlax-invoke DWX 'Register "KERNEL32" "LoadLibrary" "i=s" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "FreeLibrary" "i=p" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "GetCurrentProcessId" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "OpenProcess" "i=lll" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualProtect" "i=pllp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualProtectEx" "i=hpllp" "r=l") 
  (vlax-invoke DWX 'Register "KERNEL32" "VirtualQueryEx" "i=hppl" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "ReadProcessMemory" "i=hpplp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "WriteProcessMemory" "i=hpplp" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "GetProcAddress" "i=hs" "r=p")
  (vlax-invoke DWX 'Register "KERNEL32" "GetModuleHandle" "i=s" "r=h")
  (vlax-invoke DWX 'Register "KERNEL32" "GetLastError" "r=l")
  (vlax-invoke DWX 'Register "KERNEL32" "CloseHandle" "i=h" "r=l")
)
 
(vl-load-com)
(princ "\n帮助说明: 程序运行命令是QJYB。注意: 请运行在打开有教育版戳记的图形前!!! ")
(princ "\n命令运行一次后无需再输入，程序会自动消除教育版戳记了，你只需保存图即可。")
(princ "\n如果你希望每次都能用，请加载到启动组。")
(princ)

ARX的核心代码如下：

#include "stdafx.h"
#include "GetProcess.h"
#include "GetFunctionAddress.h"
#include "RemoveEDU.h"
 
byte OffsetAddress32[6][6]={
	{0xa4,0x06,0xa4,0x06,0xa4,0x06},//R15
	{0xd4,0x06,0xd4,0x06,0xd4,0x06},//R16
	{0xdc,0x07,0x24,0x08,0x34,0x08},//R17
	{0x6c,0x08,0x74,0x08,0x7c,0x08},//R18
	{0x84,0x08,0x84,0x08,0x84,0x08},//R19
	{0x84,0x08,0x84,0x08,0x84,0x08},//R23
};
byte OffsetAddress64[4][6]={
	{0x18,0x0b,0x18,0x0b,0x18,0x0b},//R17
	{0x80,0x0b,0x88,0x0b,0x90,0x0b},//R18
	{0xa8,0x0b,0xb0,0x0b,0xb8,0x0b},//R19
	{0xa0,0x0b,0xa0,0x0b,0xa0,0x0b},//R23
};
 
int RemoveEducationStamp(WNDINFO & wi)
{
	if (wi.ActiveDoc==NULL)
		return FALSE;
	int ret = FALSE;
    CAcadUtility uti=wi.ActiveDoc.get_Utility();
	//获取isEMR函数的RVA地址
	INT_PTR offsetAddr = 0;
	LPCSTR funcName = wi.is64bit ? "?isEMR@AcDbDatabase@@QEBA_NXZ" : "?isEMR@AcDbDatabase@@QBE_NXZ";
 
	HMODULE hDLL = LoadLibraryEx(wi.strAcDbPath,0,DONT_RESOLVE_DLL_REFERENCES);// 
	LPVOID pIsEMR = GetProcAddress(hDLL,funcName);
	FreeLibrary(hDLL);
	if (pIsEMR == NULL)
	{
		pIsEMR = LoadFuncBase(wi.strAcDbPath,funcName,hDLL);
	}
 
	if (pIsEMR == NULL)
	{
		FUNCTION_ADDRESS funcSet;
		ret = getFuncAddr(wi.strAcDbPath,funcSet);
		FUNCTION_ADDRESS::iterator itr = funcSet.find(funcName); 
		if (itr == funcSet.end())
		{
			uti.Prompt(_T("找不到教育版相关函数！可能需要以管理员身份运行此程序，或者CAD版本是2015-2018.\n"));
			return FALSE;
		}
		offsetAddr = itr->second;
		pIsEMR = LPVOID((INT_PTR)wi.hAcDb + offsetAddr); //操纵数据库
	}
	else
	{
		offsetAddr = (INT_PTR)pIsEMR - (INT_PTR)hDLL;
		pIsEMR = LPVOID((INT_PTR)wi.hAcDb + offsetAddr); //操纵数据库		
	}
 
	//以写的方式打开CAD进程
	//HANDLE hProcess = OpenProcess(PROCESS_ALL_ACCESS, FALSE, wi.dwProcessId); //权限要求太高，可能在某些机器上运行不了
	HANDLE hProcess = OpenProcess(PROCESS_VM_OPERATION | PROCESS_VM_READ | PROCESS_QUERY_INFORMATION | PROCESS_VM_WRITE, FALSE, wi.dwProcessId);
	if (hProcess == NULL)
	{
		uti.Prompt(_T("无法打开CAD进程写入!\n"));
		return FALSE;
	}
 
	const DWORD bWritten = 128;
	byte pEAX = 0;
	SIZE_T dwNumberOfBytes = 0;
 
	CString strTemp = wi.strVersion.Mid(1,2);
	int nMajorVersion = _ttoi(strTemp.GetBuffer());
	if (nMajorVersion>22) 
		nMajorVersion-=3;
	strTemp = wi.strVersion.Mid(4,1);
	int nMinorVersion = _ttoi(strTemp.GetBuffer());
 
	if (wi.is64bit)
	{
		byte AsmCode[15] = {0x48,0x8B,0x49,0x08,0x33,0xC0,0x89,0x81,0x00,0x00,0x00,0x00,0x3C,0x00,0xC3};
		nMajorVersion = nMajorVersion-17;
		AsmCode[8]=OffsetAddress64[nMajorVersion][2*nMinorVersion];
		AsmCode[9]=OffsetAddress64[nMajorVersion][2*nMinorVersion+1];
		ret = WriteProcessMemory(hProcess,pIsEMR,AsmCode,sizeof(AsmCode),&dwNumberOfBytes);
	}
	else
	{
		byte AsmCode[14] = {0x8B,0x49,0x04,0x33,0xC0,0x89,0x81,0x00,0x00,0x00,0x00,0x3C,0x00,0xC3};
		nMajorVersion = nMajorVersion-15;
		AsmCode[7]=OffsetAddress32[nMajorVersion][2*nMinorVersion];
		AsmCode[8]=OffsetAddress32[nMajorVersion][2*nMinorVersion+1];
		ret = WriteProcessMemory(hProcess,pIsEMR,AsmCode,sizeof(AsmCode),&dwNumberOfBytes);
	}
 
	if (!ret)
	{
		uti.Prompt(_T("修改内存模式失败!\n"));
	}
	else
	{
		wi.isRemoved = true;
	}
 
	CloseHandle(hProcess);
	return ret;
}

Drupal blog posts

空间之觉：一种建筑现象学

标签

Logistic映射的LISP实现

标签

利用DynamicWrapperX实现字符转换

用Javascript画图

垃圾文件清理工具

标签

简体繁体转换

标签

曲线的转弯半径和曲率

标签

小问题，大思考

标签

CAD问题小百科

去教育版戳记讨论及源码(ARX,LISP版)

标签